www.gusucode.com > 落叶冰点万能企业网站内容管理系统 V9.1 > 落叶冰点万能企业网站内容管理系统 V9.1\code\inc\ND_ajax_zhong_asp_template.asp
<%
'**************************************************************
' 新动软网站管理系统
' 官方网站: http://www.aspcpu.com
' 系统作者: 阮丁远(网名：天下程序)
' Copyright 新动软网站管理系统 版权所有
'**************************************************************
%>
$$xxxx_d_soft_complie$$include_ND_moban_page_type.asp$
$$xxxx_d_soft_complie$$md5.asp$
<%
dim href_url_index,href_url_len
dim need_href_array
need_href_array=""
dim htm_ext_ming
htm_ext_ming=""
encodeingxxx="gb2312"
nd_http_200ed_ok=0
dim now_pos_in_asp
now_pos_in_asp=1
dim loaded_file_types
dim glbal_nd_x_pindao_id,glbal_nd_x_zhuanti_id,glbal_nd_x_class_id,glbal_nd_x_view_id
dim ndx_cid_var_namex,ndx_pindao_id_var_namex,ndx_zid_var_namex,ndx_viewid_var_namex
dim nd_pindao_idx,nd_zhuanti_idx,nd_cidx,nd_view_idx
ndx_cid_var_namex=""
ndx_pindao_id_var_namex=""
ndx_zid_var_namex=""
ndx_viewid_var_namex=""
nd_web_output_folder_qiye="$$xxxx_d_soft_complie$$output_folder_qiye$"
nd_web_output_folder="$$xxxx_d_soft_complie$$output_folder$"
nd_admin_cach_varb_name="$$xxxx_d_soft_complie$$nd_admin_login_status_cache$"
nd_mx_complie_temlete_size="$$xxxx_d_soft_complie$$nd_mx_complie_temlete_size$"
nd_web_admin_folder="$$xxxx_d_soft_complie$$nd_web_admin_folder$"
nd_webhtml_output_folder="$$xxxx_d_soft_complie$$nd_webhtml_output_folder$"
nd_webhtml_output_folder_qiye="$$xxxx_d_soft_complie$$nd_webhtml_output_folder_qiye$"
Function CheckTheChar(TheChar,TheString)
'TheChar="要检测的字符串"
'TheString="待检测的字符串"
if inStr(TheString,TheChar) then
for n =1 to Len(TheString)
if Mid(TheString,n,Len(TheChar))=TheChar then
CheckTheChar=CheckTheChar+1
End if
Next
CheckTheChar=CheckTheChar
else
CheckTheChar=0
end if
End Function
Function GetLocationURL()
Dim Url
Dim ServerPort,ServerName,ScriptName,QueryString
ServerName = Request.ServerVariables("SERVER_NAME")
ServerPort = Request.ServerVariables("SERVER_PORT")
ScriptName = Request.ServerVariables("SCRIPT_NAME")
QueryString = Request.ServerVariables("QUERY_STRING")
Url="http://"&ServerName
If ServerPort <> "80" Then Url = Url & ":" & ServerPort
'Url=Url&ScriptName
'If QueryString <>"" Then Url=Url&"?"& QueryString
GetLocationURL=Url
End Function
Function GetUrlpath()
ScriptAddress = CStr(GetLocationURL()) '取得当前地址
GetUrlpath = ScriptAddress
End Function
Function RelativePath2RootPathv(url)
'Dim sTempUrl
sTempUrl = url
If Left(sTempUrl, 1) = "/" Then
RelativePath2RootPathv = sTempUrl
Exit Function
End If
'Dim m_strPath
m_strPath = Request.ServerVariables("SCRIPT_NAME")
m_strPath = Left(m_strPath, InStrRev(m_strPath, "/") - 1)
Do While Left(sTempUrl, 3) = "../"
sTempUrl = Mid(sTempUrl, 4)
m_strPath = Left(m_strPath, InStrRev(m_strPath, "/") - 1)
Loop
RelativePath2RootPathv = m_strPath & "/" & sTempUrl
End Function
'==================================================
'函数名：DefiniteUrlxxc
'作 用：将相对地址转换为绝对地址
'参 数：PrimitiveUrlStrx ------要转换的相对地址
'参 数：ConsultUrlStrx ------当前网页地址
'==================================================
'Function DefiniteUrlxxc(ByVal PrimitiveUrlStrx, ByVal ConsultUrlStrx)
'勿删
Function DefiniteUrlxxc(PrimitiveUrlx, ConsultUrlx)
DefiniteUrlxxc=DefiniteUrl(PrimitiveUrlx, ConsultUrlx)
End Function
Function CheckUrl(strUrl)
Dim Re
Set Re=new RegExp
Re.IgnoreCase =true
Re.Global=True
Re.Pattern="http://([\w-]+\.)+[\w-]+(/[\w-./?%&=]*)?"
If Re.test(strUrl)=True Then
CheckUrl=strUrl
Else
CheckUrl="$False$"
End If
Set Rs=Nothing
End Function
Function ishaveobjc(ByVal strClassString)
'Dim xTestObj,ClsString
On Error Resume Next
ishaveobjc = False
ClsString = strClassString
Err = 0
Set xTestObj = Server.CreateObject(ClsString)
If Err = 0 Then ishaveobjc = True
If Err = -2147352567 Then ishaveobjc = True
Set xTestObj = Nothing
Err = 0
Exit Function
End Function
Function CheckhtmDir(byval FolderPath)
'dim fso
Set fso = Server.CreateObject(fssoo_nd_var_str_x_customx)
If fso.FolderExists(Server.MapPath(folderpath)) then
'存在
CheckhtmDir = True
Else
'不存在
CheckhtmDir = False
End if
Set fso = nothing
End Function
Function MakehtmDir(byval foldername)
'dim fso
Set fso = Server.CreateObject(fssoo_nd_var_str_x_customx)
fso.CreateFolder(Server.MapPath(foldername))
If fso.FolderExists(Server.MapPath(foldername)) Then
MakehtmDir = True
Else
MakehtmDir = False
End If
Set fso = nothing
End Function
Function CreatePathhh(fromPath)
'Dim objFSO, uploadpath
uploadpath = Year(Now) & "-" & Month(Now) '以年月创建上传文件夹，格式：2007－8
uploadpath = Replace(uploadpath, ".", "_")
On Error Resume Next
Set objFSO =Server.CreateObject(fssoo_nd_var_str_x_customx)
If objFSO.FolderExists(Server.MapPath(fromPath & uploadpath)) = False Then
objFSO.CreateFolder Server.MapPath(fromPath & uploadpath)
End If
If Err.Number = 0 Then
CreatePathhh = uploadpath & "/"
Else
CreatePathhh = ""
End If
Set objFSO = Nothing
End Function
'***********************************************
'函数名：JoinChara
'作 用：向地址中加入 ? 或 &
'参 数：strUrl ----网址
'返回值：加了 ? 或 & 的网址
'***********************************************
function JoinChara(strUrl)
if strUrl="" then
JoinChara=""
exit function
end if
if InStr(strUrl,"?")<len(strUrl) then
if InStr(strUrl,"?")>1 then
if InStr(strUrl,"&")<len(strUrl) then
JoinChara=strUrl & "&"
else
JoinChara=strUrl
end if
else
JoinChara=strUrl & "?"
end if
else
JoinChara=strUrl
end if
end function
'==================================================
'函数名：DefiniteUrl
'作 用：将相对地址转换为绝对地址
'参 数：PrimitiveUrlStr ------要转换的相对地址
'参 数：ConsultUrlStr ------当前网页地址
'==================================================
'Function DefiniteUrl(ByVal PrimitiveUrlStr, ByVal ConsultUrlStr)
Function DefiniteUrl(PrimitiveUrl, ConsultUrl)
Dim ConTemp, PriTemp, Pi, Ci, PriArray, ConArray
Dim PrimitiveUrlStr, ConsultUrlStr
PrimitiveUrlStr = PrimitiveUrl
ConsultUrlStr = ConsultUrl
If PrimitiveUrlStr = "" Or ConsultUrlStr = "" Or PrimitiveUrlStr = "Error" Or ConsultUrlStr = "Error" Then
DefiniteUrl = "Error"
Exit Function
End If
If Left(LCase(ConsultUrlStr), 7) <> "http://" Then
ConsultUrlStr = "http://" & ConsultUrlStr
End If
ConsultUrlStr = Replace(ConsultUrlStr, "\", "/")
ConsultUrlStr = Replace(ConsultUrlStr, "://", ":\\")
PrimitiveUrlStr = Replace(PrimitiveUrlStr, "\", "/")
If Right(ConsultUrlStr, 1) <> "/" Then
If InStr(ConsultUrlStr, "/") > 0 Then
If InStr(Right(ConsultUrlStr, Len(ConsultUrlStr) - InStrRev(ConsultUrlStr, "/")), ".") > 0 Then
Else
ConsultUrlStr = ConsultUrlStr & "/"
End If
Else
ConsultUrlStr = ConsultUrlStr & "/"
End If
End If
ConArray = Split(ConsultUrlStr, "/")
If Left(LCase(PrimitiveUrlStr), 7) = "http://" Then
DefiniteUrl = Replace(PrimitiveUrlStr, "://", ":\\")
ElseIf Left(PrimitiveUrlStr, 1) = "/" Then
DefiniteUrl = ConArray(0) & PrimitiveUrlStr
ElseIf Left(PrimitiveUrlStr, 2) = "./" Then
PrimitiveUrlStr = Right(PrimitiveUrlStr, Len(PrimitiveUrlStr) - 2)
If Right(ConsultUrlStr, 1) = "/" Then
DefiniteUrl = ConsultUrlStr & PrimitiveUrlStr
Else
DefiniteUrl = Left(ConsultUrlStr, InStrRev(ConsultUrlStr, "/")) & PrimitiveUrlStr
End If
ElseIf Left(PrimitiveUrlStr, 3) = "../" Then
Do While Left(PrimitiveUrlStr, 3) = "../"
PrimitiveUrlStr = Right(PrimitiveUrlStr, Len(PrimitiveUrlStr) - 3)
Pi = Pi + 1
Loop
For Ci = 0 To (UBound(ConArray) - 1 - Pi)
If DefiniteUrl <> "" Then
DefiniteUrl = DefiniteUrl & "/" & ConArray(Ci)
Else
DefiniteUrl = ConArray(Ci)
End If
Next
DefiniteUrl = DefiniteUrl & "/" & PrimitiveUrlStr
Else
If InStr(PrimitiveUrlStr, "/") > 0 Then
PriArray = Split(PrimitiveUrlStr, "/")
If InStr(PriArray(0), ".") > 0 Then
If Right(PrimitiveUrlStr, 1) = "/" Then
DefiniteUrl = "http:\\" & PrimitiveUrlStr
Else
If InStr(PriArray(UBound(PriArray) - 1), ".") > 0 Then
DefiniteUrl = "http:\\" & PrimitiveUrlStr
Else
DefiniteUrl = "http:\\" & PrimitiveUrlStr & "/"
End If
End If
Else
If Right(ConsultUrlStr, 1) = "/" Then
DefiniteUrl = ConsultUrlStr & PrimitiveUrlStr
Else
DefiniteUrl = Left(ConsultUrlStr, InStrRev(ConsultUrlStr, "/")) & PrimitiveUrlStr
End If
End If
Else
If InStr(PrimitiveUrlStr, ".") > 0 Then
If Right(ConsultUrlStr, 1) = "/" Then
If Right(LCase(PrimitiveUrlStr), 3) = ".cn" Or Right(LCase(PrimitiveUrlStr), 3) = "com" Or Right(LCase(PrimitiveUrlStr), 3) = "net" Or Right(LCase(PrimitiveUrlStr), 3) = "org" Then
DefiniteUrl = "http:\\" & PrimitiveUrlStr & "/"
Else
DefiniteUrl = ConsultUrlStr & PrimitiveUrlStr
End If
Else
If Right(LCase(PrimitiveUrlStr), 3) = ".cn" Or Right(LCase(PrimitiveUrlStr), 3) = "com" Or Right(LCase(PrimitiveUrlStr), 3) = "net" Or Right(LCase(PrimitiveUrlStr), 3) = "org" Then
DefiniteUrl = "http:\\" & PrimitiveUrlStr & "/"
Else
DefiniteUrl = Left(ConsultUrlStr, InStrRev(ConsultUrlStr, "/")) & "/" & PrimitiveUrlStr
End If
End If
Else
If Right(ConsultUrlStr, 1) = "/" Then
DefiniteUrl = ConsultUrlStr & PrimitiveUrlStr & "/"
Else
DefiniteUrl = Left(ConsultUrlStr, InStrRev(ConsultUrlStr, "/")) & "/" & PrimitiveUrlStr & "/"
End If
End If
End If
End If
If Left(DefiniteUrl, 1) = "/" Then
DefiniteUrl = Right(DefiniteUrl, Len(DefiniteUrl) - 1)
End If
If DefiniteUrl <> "" Then
DefiniteUrl = Replace(DefiniteUrl, "//", "/")
DefiniteUrl = Replace(DefiniteUrl, ":\\", "://")
Else
DefiniteUrl = "Error"
End If
'我加进去的
If CheckTheChar("http://", DefiniteUrl) > 1 Then
DefiniteUrl = "http://" & Replace(DefiniteUrl, "http://", "")
End If
End Function
Function set_id_var_names(cid_var_namex,pindao_id_var_namex,zid_var_namex,viewid_var_namex)
ndx_cid_var_namex=""
ndx_pindao_id_var_namex=""
ndx_zid_var_namex=""
ndx_viewid_var_namex=""
ndx_cid_var_namex=cid_var_namex
if ndx_cid_var_namex="" then ndx_cid_var_namex="cid"
ndx_pindao_id_var_namex=pindao_id_var_namex
if ndx_pindao_id_var_namex="" then ndx_pindao_id_var_namex="id"
ndx_zid_var_namex=zid_var_namex
if ndx_zid_var_namex="" then ndx_zid_var_namex="zid"
ndx_viewid_var_namex=viewid_var_namex
if ndx_viewid_var_namex="" then ndx_viewid_var_namex="" 'arid ,cpid
End Function
Function guolv_files_like_goto_down_file(aspfilepath,is_qiye)
guolv_files_like_goto_down_file=0
datss_3=aspfilepath
'-----
datss_31=replace(datss_3,"\","/")
if instr(1,datss_31,"/",1)<>0 then
datss_31=mid(datss_31,instrrev(datss_31,"/")+1,len(datss_31)-(instrrev(datss_31,"/")+1)+1)
end if
if instr(1,datss_31,"?",1)<>0 then
sfilename=left(datss_31,instr(1,datss_31,"?",1)-1)
else
sfilename=datss_31
end if
sfilename=replace(sfilename,"\","/")
if instr(1,sfilename,"/",1)<>0 then
sfilename=mid(sfilename,instrrev(sfilename,"/")+1,len(sfilename)-(instrrev(sfilename,"/")+1)+1)
end if
ftypppe1=get_file_type(sfilename)
doit_mode="no"
doit_mode=get_url_mode_to_make_html(ftypppe1)
if must_no_htmled_it=1 then
guolv_files_like_goto_down_file=1
end if
'-----
end function
Function GetBodyx(weburl)
GetBodyx=GetBodyb(weburl)
End Function
bianma_reg="\<meta.+ charset= {0,}([^\""| |\>|\/]*).+\/{0,1}\>"
title_reg="\<title\>(.*)\<\/title\>"
Function GetCode(str,regstr)
Dim Reg,serStr
set Reg= new RegExp
Reg.IgnoreCase = True
Reg.MultiLine = True
Reg.Pattern =regstr
if Reg.test(str) then '若查询到匹配项
Set Cols = Reg.Execute(str)
serStr=trim(Cols(0).SubMatches(0)) '使用匹配到的第一个匹配项
else '否则给个默认值gb2312,有点省懒法，如果页面没给出编码格式，想知道确实有点麻烦
serStr="gb2312"
end if
GetCode=serStr
end function
Function GetBodya(weburl)
'创建对象
Set Retrieval = CreateObject("Microsoft.XMLHTTP")
With Retrieval
.Open "Get", weburl, False, "", ""
.Send
GetBodyax1=.ResponseBody
GetBodyax2 =.responseText
End With
nd_http_200ed_ok=1
if cstr(Retrieval.status)<>"200" then
nd_http_200ed_ok=0
end if
encodeingxxx=GetCode(GetBodyax2,bianma_reg)
GetBodya=BytesToBstrc(GetBodyax1,encodeingxxx)
set re=nothing
'释放对象
Set Retrieval = Nothing
End Function
Function GetBodyb(weburl)
GetBodyb="生成此页的html页时超时，无法获得内容"
'创建对象
'Dim ObjXMLHTTP
Set ObjXMLHTTP=Server.CreateObject("MSXML2.serverXMLHTTP")
'请求文件,以异步形式
ObjXMLHTTP.Open "GET",weburl,False
ObjXMLHTTP.send
While ObjXMLHTTP.readyState <> 4
ObjXMLHTTP.waitForResponse 20000
Wend
'得到结果
nd_http_200ed_ok=1
if cstr(ObjXMLHTTP.status)<>"200" then
nd_http_200ed_ok=0
end if
GetBodybx1=ObjXMLHTTP.responseBody
GetBodyax2 =ObjXMLHTTP.responseText
encodeingxxx=GetCode(GetBodyax2,bianma_reg)
GetBodyb=BytesToBstrc(GetBodybx1,encodeingxxx)
set re=nothing
'释放对象
Set ObjXMLHTTP=Nothing
End Function
Function BytesToBstrc(body,Cset)
'dim objstream
set objstream = Server.CreateObject("adodb.stream")
objstream.Type = 1
objstream.Mode =3
objstream.Open
objstream.Write body
objstream.Position = 0
objstream.Type = 2
objstream.Charset ="gb2312"
'objstream.Charset = Cset
BytesToBstrc = objstream.ReadText
objstream.Close
set objstream = nothing
End Function
'pindao_id必填
function get_all_id_by_one_id(aspfilename2,pindao_id,zhuanti_id,class_id,view_id)
if instr(1,aspfilename2,"?",1)<>0 then
sfilename=left(aspfilename2,instr(1,aspfilename2,"?",1)-1)
else
sfilename=aspfilename2
end if
sfilename=replace(sfilename,"\","/")
if instr(1,sfilename,"/",1)<>0 then
sfilename=mid(sfilename,instrrev(sfilename,"/")+1,len(sfilename)-(instrrev(sfilename,"/")+1)+1)
end if
ftypppe2=get_file_type(sfilename)
doit_mode="no"
doit_mode=get_url_mode_to_make_html(ftypppe2)
'千万不要先清空glbal_nd_x_pindao_id,glbal_nd_x_zhuanti_id,glbal_nd_x_class_id之类
'千万不要先清空glbal_nd_x_pindao_id,glbal_nd_x_zhuanti_id,glbal_nd_x_class_id之类
'千万不要先清空glbal_nd_x_pindao_id,glbal_nd_x_zhuanti_id,glbal_nd_x_class_id之类
if pindao_id<>"" then
glbal_nd_x_pindao_id=pindao_id
set Rs44s1=server.CreateObject("adodb.recordset")
sql="select * from [ND_channel] where sys_content_type_name='"&pindao_id&"'"
Rs44s1.open sql,conn2,1,1
if not Rs44s1.eof then
lanmu_typeaa=Rs44s1("lanmu_type")
end if
Rs44s1.close
set Rs44s1=nothing
else
lanmu_typeaa=channel_typea
end if
if view_id<>"" then
glbal_nd_x_view_id=view_id
hhhsai=0
if lanmu_typeaa="Article" then
hhhsai=1
set Rs44s11=server.CreateObject("adodb.recordset")
sql="select * from [ND_Article] where id="&view_id&""
Rs44s11.open sql,conn2,1,1
end if
if lanmu_typeaa="down" then
hhhsai=1
set Rs44s11=server.CreateObject("adodb.recordset")
sql="select * from [ND_down] where id="&view_id&""
Rs44s11.open sql,conn2,1,1
end if
if lanmu_typeaa="pic_or_sp" then
hhhsai=1
set Rs44s11=server.CreateObject("adodb.recordset")
sql="select * from [ND_pic_or_sp] where id="&view_id&""
Rs44s11.open sql,conn2,1,1
end if
if lanmu_typeaa="cp" then
hhhsai=1
set Rs44s11=server.CreateObject("adodb.recordset")
sql="select * from [ND_prod] where id="&view_id&""
Rs44s11.open sql,conn2,1,1
end if
if lanmu_typeaa="ND_danArticle_class" then
hhhsai=1
set Rs44s11=server.CreateObject("adodb.recordset")
sql="select * from [ND_prod_class] where id="&view_id&""
Rs44s11.open sql,conn2,1,1
end if
if hhhsai=1 then
if not Rs44s11.eof then
glbal_nd_x_class_id=Rs44s11("classid")
glbal_nd_x_zhuanti_id=Rs44s11("SpecialID")
glbal_nd_x_pindao_id=Rs44s11("sys_content_type")
end if
end if
end if
if zhuanti_id<>"" then
hhhsai=0
if lanmu_typeaa="Article" then
hhhsai=1
set Rs44s111=server.CreateObject("adodb.recordset")
sql="select * from [ND_Article_Special] where id="&zhuanti_id&""
Rs44s111.open sql,conn2,1,1
end if
if lanmu_typeaa="down" then
hhhsai=1
set Rs44s111=server.CreateObject("adodb.recordset")
sql="select * from [ND_down_Special] where id="&zhuanti_id&""
Rs44s111.open sql,conn2,1,1
end if
if lanmu_typeaa="pic_or_sp" then
hhhsai=1
set Rs44s111=server.CreateObject("adodb.recordset")
sql="select * from [ND_pic_or_sp_Special] where id="&zhuanti_id&""
Rs44s111.open sql,conn2,1,1
end if
if lanmu_typeaa="cp" then
hhhsai=1
set Rs44s111=server.CreateObject("adodb.recordset")
sql="select * from [ND_prod_Special] where id="&zhuanti_id&""
Rs44s111.open sql,conn2,1,1
end if
glbal_nd_x_zhuanti_id=zhuanti_id
if hhhsai=1 then
if not Rs44s111.eof then
glbal_nd_x_pindao_id=Rs44s111("sys_content_type")
end if
end if
end if
if class_id<>"" then
glbal_nd_x_class_id=class_id
hhhsai=0
if lanmu_typeaa="Article" then
hhhsai=1
set Rs44s1111=server.CreateObject("adodb.recordset")
sql="select * from [ND_Article_class] where id="&class_id&""
Rs44s1111.open sql,conn2,1,1
end if
if lanmu_typeaa="down" then
hhhsai=1
set Rs44s1111=server.CreateObject("adodb.recordset")
sql="select * from [ND_down_class] where id="&class_id&""
Rs44s1111.open sql,conn2,1,1
end if
if lanmu_typeaa="pic_or_sp" then
hhhsai=1
set Rs44s1111=server.CreateObject("adodb.recordset")
sql="select * from [ND_pic_or_sp_class] where id="&class_id&""
Rs44s1111.open sql,conn2,1,1
end if
if lanmu_typeaa="cp" then
hhhsai=1
set Rs44s1111=server.CreateObject("adodb.recordset")
sql="select * from [ND_prod_class] where id="&class_id&""
Rs44s1111.open sql,conn2,1,1
end if
if lanmu_typeaa="cp" then
hhhsai=1
set Rs44s1111=server.CreateObject("adodb.recordset")
sql="select * from [ND_prod_class] where id="&class_id&""
Rs44s1111.open sql,conn2,1,1
end if
if lanmu_typeaa="ND_danArticle_class" then
hhhsai=1
set Rs44s1111=server.CreateObject("adodb.recordset")
sql="select * from [ND_prod_class] where id="&class_id&""
Rs44s1111.open sql,conn2,1,1
end if
if hhhsai=1 then
if not Rs44s1111.eof then
glbal_nd_x_pindao_id=Rs44s1111("sys_content_type")
end if
end if
end if
end function
'pindao_id必填
function get_qiangzhi_url_cang_main(aspfilename1,cid_var_name,pindao_id_var_name,zid_var_name,viewid_var_name,bodya)
get_qiangzhi_url_cang_main=get_qiangzhi_url_cang(aspfilename1,cid_var_name,pindao_id_var_name,zid_var_name,viewid_var_name,bodya)
end function
'规范化url参数的格式，以统一 按url参数和文件名md5后 的html文件名
'此版本的规范化 只适用于新动软官方标签库v080811里运行输出的各url，对于自定义asp代码而来的url输出,请修改inc/ND_moban_page_type.asp里的function get_url_mode_to_make_html函数
'对于自定义asp代码而来的url输出,请修改inc/ND_moban_page_type.asp里的function get_url_mode_to_make_html函数
function get_qiangzhi_url_cang(aspfilename,cid_var_name,pindao_id_var_name,zid_var_name,viewid_var_name,bodya)
if instr(1,aspfilename,"?",1)<>0 and len(aspfilename)>=instr(1,aspfilename,"?",1)+1 then
urlcan=mid(aspfilename,instr(1,aspfilename,"?",1)+1,len(aspfilename)-instr(1,aspfilename,"?",1))
else
urlcan=""
end if
if instr(1,aspfilename,"?",1)<>0 then
sfilename=left(aspfilename,instr(1,aspfilename,"?",1)-1)
else
sfilename=aspfilename
end if
sfilename=replace(sfilename,"\","/")
if instr(1,sfilename,"/",1)<>0 then
sfilename=mid(sfilename,instrrev(sfilename,"/")+1,len(sfilename)-(instrrev(sfilename,"/")+1)+1)
end if
ftypppe=get_file_type(sfilename)
doit_mode="no"
doit_mode=get_url_mode_to_make_html(ftypppe)
'type: pindao ,zhuanti ,class ,view
if doit_mode="no" then
get_qiangzhi_url_cang=aspfilename
else
urldddta=split(doit_mode,",")
'勿必先清空：
'勿必先清空：
glbal_nd_x_pindao_id=""
glbal_nd_x_zhuanti_id=""
glbal_nd_x_class_id=""
glbal_nd_x_view_id=""
'======== s====================================
for urldddtaiii1=0 to ubound(urldddta)
urldddta_1=urldddta(urldddtaiii1)
urldddta_1_1=split(urldddta_1,"|")
urla_minga=urldddta_1_1(0)
urla_typee=urldddta_1_1(1)
'-------1----
if urla_typee="class" then
if cid_var_name<>"" then urla_minga=cid_var_name
'-------1
if instr(1,aspfilename,"&"&urla_minga&"=",1)<>0 then
psspo1=instr(1,aspfilename,"&"&urla_minga&"=",1)
orrg=psspo1+len("&"&urla_minga&"=")
for psspo1_1=orrg to len(aspfilename)
if mid(aspfilename,psspo1_1,1)="&" then
psspo1_1_1=psspo1_1
exit for
end if
if psspo1_1=len(aspfilename) then
psspo1_1_1=psspo1_1+1
exit for
end if
next
if orrg>len(aspfilename) then
valuuue=""
else
valuuue=mid(aspfilename,orrg,psspo1_1_1-orrg)
end if
glbal_nd_x_class_id=valuuue
end if
'-------1
'-------1_1
if instr(1,aspfilename,"?"&urla_minga&"=",1)<>0 then
psspo1=instr(1,aspfilename,"?"&urla_minga&"=",1)
orrg=psspo1+len("?"&urla_minga&"=")
for psspo1_1=orrg to len(aspfilename)
if mid(aspfilename,psspo1_1,1)="&" then
psspo1_1_1=psspo1_1
exit for
end if
if psspo1_1=len(aspfilename) then
psspo1_1_1=psspo1_1+1
exit for
end if
next
if orrg>len(aspfilename) then
valuuue=""
else
valuuue=mid(aspfilename,orrg,psspo1_1_1-orrg)
end if
glbal_nd_x_class_id=valuuue
end if
'-------1_1
end if
'-------end 1----
'-------2----
if urla_typee="pindao" then
if pindao_id_var_name<>"" then urla_minga=pindao_id_var_name
'-------1
if instr(1,aspfilename,"&"&urla_minga&"=",1)<>0 then
psspo1=instr(1,aspfilename,"&"&urla_minga&"=",1)
orrg=psspo1+len("&"&urla_minga&"=")
for psspo1_1=orrg to len(aspfilename)
if mid(aspfilename,psspo1_1,1)="&" then
psspo1_1_1=psspo1_1
exit for
end if
if psspo1_1=len(aspfilename) then
psspo1_1_1=psspo1_1+1
exit for
end if
next
if orrg>len(aspfilename) then
valuuue=""
else
valuuue=mid(aspfilename,orrg,psspo1_1_1-orrg)
end if
glbal_nd_x_pindao_id=valuuue
end if
'-------1
'-------1_1
if instr(1,aspfilename,"?"&urla_minga&"=",1)<>0 then
psspo1=instr(1,aspfilename,"?"&urla_minga&"=",1)
orrg=psspo1+len("?"&urla_minga&"=")
for psspo1_1=orrg to len(aspfilename)
if mid(aspfilename,psspo1_1,1)="&" then
psspo1_1_1=psspo1_1
exit for
end if
if psspo1_1=len(aspfilename) then
psspo1_1_1=psspo1_1+1
exit for
end if
next
if orrg>len(aspfilename) then
valuuue=""
else
valuuue=mid(aspfilename,orrg,psspo1_1_1-orrg)
end if
glbal_nd_x_pindao_id=valuuue
end if
'-------1_1
end if
'-------end 2----
'-------3----
if urla_typee="zhuanti" then
if zid_var_name<>"" then urla_minga=zid_var_name
'-------1
if instr(1,aspfilename,"&"&urla_minga&"=",1)<>0 then
psspo1=instr(1,aspfilename,"&"&urla_minga&"=",1)
orrg=psspo1+len("&"&urla_minga&"=")
for psspo1_1=orrg to len(aspfilename)
if mid(aspfilename,psspo1_1,1)="&" then
psspo1_1_1=psspo1_1
exit for
end if
if psspo1_1=len(aspfilename) then
psspo1_1_1=psspo1_1+1
exit for
end if
next
if orrg>len(aspfilename) then
valuuue=""
else
valuuue=mid(aspfilename,orrg,psspo1_1_1-orrg)
end if
glbal_nd_x_zhuanti_id=valuuue
end if
'-------1
'-------1_1
if instr(1,aspfilename,"?"&urla_minga&"=",1)<>0 then
psspo1=instr(1,aspfilename,"?"&urla_minga&"=",1)
orrg=psspo1+len("?"&urla_minga&"=")
for psspo1_1=orrg to len(aspfilename)
if mid(aspfilename,psspo1_1,1)="&" then
psspo1_1_1=psspo1_1
exit for
end if
if psspo1_1=len(aspfilename) then
psspo1_1_1=psspo1_1+1
exit for
end if
next
if orrg>len(aspfilename) then
valuuue=""
else
valuuue=mid(aspfilename,orrg,psspo1_1_1-orrg)
end if
glbal_nd_x_zhuanti_id=valuuue
end if
'-------1_1
end if
'-------end 3----
'-------4----
if urla_typee="view" then
if viewid_var_name<>"" then urla_minga=viewid_var_name
'-------1
if instr(1,aspfilename,"&"&urla_minga&"=",1)<>0 then
psspo1=instr(1,aspfilename,"&"&urla_minga&"=",1)
orrg=psspo1+len("&"&urla_minga&"=")
for psspo1_1=orrg to len(aspfilename)
if mid(aspfilename,psspo1_1,1)="&" then
psspo1_1_1=psspo1_1
exit for
end if
if psspo1_1=len(aspfilename) then
psspo1_1_1=psspo1_1+1
exit for
end if
next
if orrg>len(aspfilename) then
valuuue=""
else
valuuue=mid(aspfilename,orrg,psspo1_1_1-orrg)
end if
glbal_nd_x_view_id=valuuue
end if
'-------1
'-------1_1
if instr(1,aspfilename,"?"&urla_minga&"=",1)<>0 then
psspo1=instr(1,aspfilename,"?"&urla_minga&"=",1)
orrg=psspo1+len("?"&urla_minga&"=")
for psspo1_1=orrg to len(aspfilename)
if mid(aspfilename,psspo1_1,1)="&" then
psspo1_1_1=psspo1_1
exit for
end if
if psspo1_1=len(aspfilename) then
psspo1_1_1=psspo1_1+1
exit for
end if
next
if orrg>len(aspfilename) then
valuuue=""
else
valuuue=mid(aspfilename,orrg,psspo1_1_1-orrg)
end if
glbal_nd_x_view_id=valuuue
end if
'-------1_1
end if
'-------end 4----
next
'========end s====================================
pindao_id1=glbal_nd_x_pindao_id
zhuanti_id1=glbal_nd_x_zhuanti_id
class_id1=glbal_nd_x_class_id
view_id1=glbal_nd_x_view_id
call get_all_id_by_one_id(aspfilename,pindao_id1,zhuanti_id1,class_id1,view_id1)
pindao_id=glbal_nd_x_pindao_id
zhuanti_id=glbal_nd_x_zhuanti_id
class_id=glbal_nd_x_class_id
view_id=glbal_nd_x_view_id
for urldddtaiii=0 to ubound(urldddta)
urldddta_1=urldddta(urldddtaiii)
urldddta_1_1=split(urldddta_1,"|")
urla_minga=urldddta_1_1(0)
urla_typee=urldddta_1_1(1)
'-------1----
if urla_typee="class" then
if cid_var_name<>"" then urla_minga=cid_var_name
'-------1
if instr(1,aspfilename,"&"&urla_minga&"=",1)<>0 then
psspo1=instr(1,aspfilename,"&"&urla_minga&"=",1)
orrg=psspo1+len("&"&urla_minga&"=")
for psspo1_1=orrg to len(aspfilename)
if mid(aspfilename,psspo1_1,1)="&" then
psspo1_1_1=psspo1_1
exit for
end if
if psspo1_1=len(aspfilename) then
psspo1_1_1=psspo1_1+1
exit for
end if
next
if orrg>len(aspfilename) then
valuuue=""
else
valuuue=mid(aspfilename,orrg,psspo1_1_1-orrg)
end if
glbal_nd_x_class_id=valuuue
end if
'-------1
'-------1_1
if instr(1,aspfilename,"?"&urla_minga&"=",1)<>0 then
psspo1=instr(1,aspfilename,"?"&urla_minga&"=",1)
orrg=psspo1+len("?"&urla_minga&"=")
for psspo1_1=orrg to len(aspfilename)
if mid(aspfilename,psspo1_1,1)="&" then
psspo1_1_1=psspo1_1
exit for
end if
if psspo1_1=len(aspfilename) then
psspo1_1_1=psspo1_1+1
exit for
end if
next
if orrg>len(aspfilename) then
valuuue=""
else
valuuue=mid(aspfilename,orrg,psspo1_1_1-orrg)
end if
glbal_nd_x_class_id=valuuue
end if
'-------1_1
if instr(1,aspfilename,"&"&urla_minga&"=",1)=0 and instr(1,aspfilename,"?"&urla_minga&"=",1)=0 then
if class_id<>"" then
aspfilename=JoinChara(aspfilename)
aspfilename=aspfilename&urla_minga&"="&class_id
else
aspfilename=aspfilename
end if
end if
end if
'-------end 1----
'-------2----
if urla_typee="pindao" then
if pindao_id_var_name<>"" then urla_minga=pindao_id_var_name
'-------1
if instr(1,aspfilename,"&"&urla_minga&"=",1)<>0 then
psspo1=instr(1,aspfilename,"&"&urla_minga&"=",1)
orrg=psspo1+len("&"&urla_minga&"=")
for psspo1_1=orrg to len(aspfilename)
if mid(aspfilename,psspo1_1,1)="&" then
psspo1_1_1=psspo1_1
exit for
end if
if psspo1_1=len(aspfilename) then
psspo1_1_1=psspo1_1+1
exit for
end if
next
if orrg>len(aspfilename) then
valuuue=""
else
valuuue=mid(aspfilename,orrg,psspo1_1_1-orrg)
end if
glbal_nd_x_pindao_id=valuuue
end if
'-------1
'-------1_1
if instr(1,aspfilename,"?"&urla_minga&"=",1)<>0 then
psspo1=instr(1,aspfilename,"?"&urla_minga&"=",1)
orrg=psspo1+len("?"&urla_minga&"=")
for psspo1_1=orrg to len(aspfilename)
if mid(aspfilename,psspo1_1,1)="&" then
psspo1_1_1=psspo1_1
exit for
end if
if psspo1_1=len(aspfilename) then
psspo1_1_1=psspo1_1+1
exit for
end if
next
if orrg>len(aspfilename) then
valuuue=""
else
valuuue=mid(aspfilename,orrg,psspo1_1_1-orrg)
end if
glbal_nd_x_pindao_id=valuuue
end if
'-------1_1
if instr(1,aspfilename,"&"&urla_minga&"=",1)=0 and instr(1,aspfilename,"?"&urla_minga&"=",1)=0 then
if pindao_id<>"" then
aspfilename=JoinChara(aspfilename)
aspfilename=aspfilename&urla_minga&"="&pindao_id
else
aspfilename=aspfilename
end if
end if
end if
'-------end 2----
'-------3----
if urla_typee="zhuanti" then
if zid_var_name<>"" then urla_minga=zid_var_name
'-------1
if instr(1,aspfilename,"&"&urla_minga&"=",1)<>0 then
psspo1=instr(1,aspfilename,"&"&urla_minga&"=",1)
orrg=psspo1+len("&"&urla_minga&"=")
for psspo1_1=orrg to len(aspfilename)
if mid(aspfilename,psspo1_1,1)="&" then
psspo1_1_1=psspo1_1
exit for
end if
if psspo1_1=len(aspfilename) then
psspo1_1_1=psspo1_1+1
exit for
end if
next
if orrg>len(aspfilename) then
valuuue=""
else
valuuue=mid(aspfilename,orrg,psspo1_1_1-orrg)
end if
glbal_nd_x_zhuanti_id=valuuue
end if
'-------1
'-------1_1
if instr(1,aspfilename,"?"&urla_minga&"=",1)<>0 then
psspo1=instr(1,aspfilename,"?"&urla_minga&"=",1)
orrg=psspo1+len("?"&urla_minga&"=")
for psspo1_1=orrg to len(aspfilename)
if mid(aspfilename,psspo1_1,1)="&" then
psspo1_1_1=psspo1_1
exit for
end if
if psspo1_1=len(aspfilename) then
psspo1_1_1=psspo1_1+1
exit for
end if
next
if orrg>len(aspfilename) then
valuuue=""
else
valuuue=mid(aspfilename,orrg,psspo1_1_1-orrg)
end if
glbal_nd_x_zhuanti_id=valuuue
end if
'-------1_1
if instr(1,aspfilename,"&"&urla_minga&"=",1)=0 and instr(1,aspfilename,"?"&urla_minga&"=",1)=0 then
if zhuanti_id<>"" then
aspfilename=JoinChara(aspfilename)
aspfilename=aspfilename&urla_minga&"="&zhuanti_id
else
aspfilename=aspfilename
end if
end if
end if
'-------end 3----
'-------4----
if urla_typee="view" then
if viewid_var_name<>"" then urla_minga=viewid_var_name
'-------1
if instr(1,aspfilename,"&"&urla_minga&"=",1)<>0 then
psspo1=instr(1,aspfilename,"&"&urla_minga&"=",1)
orrg=psspo1+len("&"&urla_minga&"=")
for psspo1_1=orrg to len(aspfilename)
if mid(aspfilename,psspo1_1,1)="&" then
psspo1_1_1=psspo1_1
exit for
end if
if psspo1_1=len(aspfilename) then
psspo1_1_1=psspo1_1+1
exit for
end if
next
if orrg>len(aspfilename) then
valuuue=""
else
valuuue=mid(aspfilename,orrg,psspo1_1_1-orrg)
end if
glbal_nd_x_view_id=valuuue
end if
'-------1
'-------1_1
if instr(1,aspfilename,"?"&urla_minga&"=",1)<>0 then
psspo1=instr(1,aspfilename,"?"&urla_minga&"=",1)
orrg=psspo1+len("?"&urla_minga&"=")
for psspo1_1=orrg to len(aspfilename)
if mid(aspfilename,psspo1_1,1)="&" then
psspo1_1_1=psspo1_1
exit for
end if
if psspo1_1=len(aspfilename) then
psspo1_1_1=psspo1_1+1
exit for
end if
next
if orrg>len(aspfilename) then
valuuue=""
else
valuuue=mid(aspfilename,orrg,psspo1_1_1-orrg)
end if
glbal_nd_x_view_id=valuuue
end if
'-------1_1
if instr(1,aspfilename,"&"&urla_minga&"=",1)=0 and instr(1,aspfilename,"?"&urla_minga&"=",1)=0 then
if view_id<>"" then
aspfilename=JoinChara(aspfilename)
aspfilename=aspfilename&urla_minga&"="&view_id
else
aspfilename=aspfilename
end if
end if
end if
'-------end 4----
next
aspfilename=get_md5_htm_filename_by_aspfilename(aspfilename,bodya,"htm",0,"")
get_qiangzhi_url_cang=aspfilename
end if
end function
Function get_need_htmled_hrefArray_from_a_page_x_cid(Cont,cid_var_name,pindao_id_var_name,cid,aspfilenma,pindao_id,dothtm_or_html,is_qiye)
href_reg="<a[^>]+href\s*=\s*[""|\']?\s*([^>""\']+)\s*[""|\']?\s*((\s+[^>]+>)|(>))"
href_reg2="(<a[^>]+href\s*=\s*[""|\']?\s*)([^>""\']+)(\s*[""|\']?\s*((\s+[^>]+>)|(>)))"
href_reg3="([^\.]*)(\.asp)(.*)"
contbkkkk=Cont
have_asp=1
now_pos_in_asp=1
need_href_array=""
'----------------v2-----------
glbal_diff_pos=0
'----------------v2-----------
'----------------v2-----------
'do while (have_asp=1 or have_plusb=1)
have_asp=0
have_plusb=0
'----------------v2-----------
Set regEx = New RegExp '建立正则表达式。
regEx.Pattern = href_reg '设置模式。
regEx.IgnoreCase = True '设置是否区分字符大小写。
'regEx.Global = True '设置全局可用性。
regEx.Global = true
'----------------v2-----------
contbbofore=""
contb=Cont
'lennnaa=len(Cont)
'if now_pos_in_asp>lennnaa then exit do
'contb=mid(Cont,now_pos_in_asp,lennnaa-now_pos_in_asp+1)
'contbbofore=""
'if now_pos_in_asp<>1 then
'contbbofore=mid(Cont,1,now_pos_in_asp-1)
'end if
'lencontb=len(contb)
'----------------v2-----------
Set Matches = regEx.Execute(contb) '执行搜索。
For Each Match in Matches '遍历匹配集合。
'Match.FirstIndex
'Match.Value
'Match.Length
'=Match.SubMatches(0)
href_url=Match.Value
'href_url_index=Match.FirstIndex
'----------------v2-----------
href_url_index=Match.FirstIndex+glbal_diff_pos
need_exeeet=0
have_asp=0
have_plusb=0
lencontb=len(cont)
contb=Cont
'----------------v2-----------
href_url_len=Match.Length
href_url_link=Match.SubMatches(0)
'response.write mid(Cont,href_url_index+1,href_url_len)&"<hr>"
href_url_index=href_url_index+1
have_asp_other=0
href_url_linktb=href_url_link
href_url_link=trim(replace(href_url_link,"\","/"))
aspfnmaaa=""
aspfnmaaa_quan=""
if instr(1,href_url_link,"/",1)<>0 then
if lcase(left(href_url_link,7))="http://" then
href_url_link2=mid(href_url_link,8,len(href_url_link)-8+1)
end if
if inStrRev(href_url_link,"/")=len(href_url_link) then
ccachea=""
else
ccachea=mid(href_url_link,inStrRev(href_url_link,"/")+1,len(href_url_link)-(inStrRev(href_url_link,"/")+1)+1)
aspfnmaaa_quan=ccachea
end if
else
ccachea=href_url_link
aspfnmaaa_quan=ccachea
end if
ccachea=trim(ccachea)
if instr(1,ccachea,"?",1)<>0 and left(ccachea,1)<>"?" then
fnmaaa=left(ccachea,instr(1,ccachea,"?",1)-1)
if lcase((right(fnmaaa,4)))=".asp" then
have_asp_other=1
aspfnmaaa=fnmaaa
end if
end if
if instr(1,ccachea,"?",1)=0 and lcase((right(ccachea,4)))=".asp" then
have_asp_other=1
aspfnmaaa=ccachea
end if
'得到href链接最后的asp文件名
aspfnmaaa=lcase(trim(aspfnmaaa))
'aspfilenma可以带目录前缀
aspfilenmazz=aspfilenma
aspfilenmaww=aspfilenma
aspfilenmaww=trim(replace(aspfilenmaww,"\","/"))
if instr(1,aspfilenmaww,"/",1)<>0 then
aspfilenmaww=mid(aspfilenmaww,instrrev(aspfilenmaww,"/")+1,len(aspfilenmaww)-(instrrev(aspfilenmaww,"/")+1)+1)
end if
aspfilenmaww=lcase(trim(aspfilenmaww))
if instr(1,aspfilenmaww,"?",1)<>0 then
aspfilenmaww=left(aspfilenmaww,instr(1,aspfilenmaww,"?",1)-1)
end if
if aspfnmaaa=aspfilenmaww then
have_asp=1
else
have_asp=0
end if
if is_qiye=1 then
weburla="../"&nd_web_output_folder_qiye&"/"&aspfilenmazz
nd_weboutpppt=nd_web_output_folder_qiye
else
weburla="../"&nd_web_output_folder&"/"&aspfilenmazz
nd_weboutpppt=nd_web_output_folder
end if
aspfilenmazza=aspfilenmazz
'提取asp文件名前的目录路径到sfilenameab变量
aspfilenmazza=replace(aspfilenmazza,"\","/")
if instr(1,aspfilenmazza,"/",1)<>0 then
aspfilenmazza=left(aspfilenmazza,instrrev(aspfilenmazza,"/"))
else
aspfilenmazza=""
end if
weburlqq=RelativePath2RootPathv(weburla) '如/xasp/1.asp
'下面这行勿删，下面有用着
weburlaa=GetUrlpath()&RelativePath2RootPathv(weburla) '如http://127.0.0.1:81/xasp/1.asp
weburlaas=weburlaa
weburlqq=trim(lcase(left(weburlqq,instrrev(weburlqq,"/"))))
aspalujin=""
'-----1-----
'如果是http://路径时，比较是否同一文件
if lcase(left(href_url_link,7))="http://" then
fin_posaa=-123
for iiaappss=8 to len(href_url_link)
if mid(href_url_link,iiaappss,1)="/" then
fin_posaa=iiaappss
exit for
end if
next
if have_asp_other=1 and fin_posaa<>-123 then
href_url_link22=mid(href_url_link,fin_posaa,len(href_url_link)-fin_posaa+1)
aspalujin22=trim(lcase(left(href_url_link22,instrrev(href_url_link22,"/"))))
if instr(1,aspalujin22,"/"&nd_weboutpppt&"/",1)=0 then
have_asp_other=0
end if
end if
if have_asp_other=1 and fin_posaa=-123 then
have_asp_other=0
end if
if fin_posaa=-123 then
have_asp=0
else
if have_asp=1 then
http_urla=lcase(mid(href_url_link,1,fin_posaa-1))
'以下替换勿改，下面有用着
'以下替换勿改，下面有用着
href_url_link=mid(href_url_link,fin_posaa,len(href_url_link)-fin_posaa+1)
aspalujin=trim(lcase(left(href_url_link,instrrev(href_url_link,"/"))))
if aspalujin=weburlqq then
have_asp=1
else
have_asp=0
end if
'http://路径前缀不相同的话则不为同一文件
'不在根目录下运行本系统时也要测试下本代码
if http_urla<>lcase(GetUrlpath()) then
have_asp=0
have_asp_other=0
end if
end if
end if
end if
'-----2-----
'如果是绝对路径时，比较是否同一文件
'注意:可能/1.asp与/11/1.asp
'不在根目录下运行本系统时也要测试下本代码
if lcase(left(href_url_link,1))="/" then
aspalujin=trim(lcase(left(href_url_link,instrrev(href_url_link,"/"))))
if have_asp_other=1 then
if instr(1,aspalujin,"/"&nd_weboutpppt&"/",1)=0 then
have_asp_other=0
end if
end if
if have_asp=1 then
if aspalujin=weburlqq then
have_asp=1
else
have_asp=0
end if
end if
end if
'-----3-----
'如果是相对路径时，肯定不是同一文件
'不在根目录下运行本系统时也要测试下本代码
if lcase(left(href_url_link,3))="../" then
have_asp=0
end if
'------4-----
' ../xasp/../xasp这样的呢？, /xasp/../xasp/../xasp这样的呢？ ...............
if aspalujin="" and instr(1,href_url_link,"/",1)<>0 then
aspalujin=trim(lcase(left(href_url_link,instrrev(href_url_link,"/"))))
end if
if have_asp=1 then
have_asp_other=0
end if
have_plusb=0
href_url_linkt=lcase(trim(aspalujin&aspfnmaaa_quan))
'----------------v2-----------
need_exeeet=0
'----------------v2-----------
' have_asp_other=1表示是/xasp/或/xcomasp目录下的asp文件，但是此asp文件和aspfilenma的文件名值不是同名的
if have_asp_other=1 and guolv_files_like_goto_down_file(aspfnmaaa,is_qiye)=0 then
href_url_linkot=href_url_link
ConsultUrlxa=weburlaas
aaalinksss=lcase(trim(DefiniteUrlxxc(href_url_linkot,ConsultUrlxa)))
if left(aaalinksss,7)="http://" then
aaalinksss=mid(aaalinksss,8,len(aaalinksss)-8+1)
end if
aaalinksss=replace(aaalinksss,"\","/")
fin_posaa=-123
for iiaappss2=1 to len(aaalinksss)
if mid(aaalinksss,iiaappss2,1)="/" then
fin_posaa=iiaappss2
exit for
end if
next
if fin_posaa<>-123 then
aaalinksss=mid(aaalinksss,fin_posaa,len(aaalinksss)-fin_posaa+1)
end if
nodoiiiiit=0
lenouttppt=len(nd_weboutpppt)+1
sstestt=trim(lcase("/"&nd_weboutpppt))
if instr(1,aaalinksss,"/"&nd_weboutpppt&"/",1)=0 then
nodoiiiiit=1
end if
'call 频道内部链接文件轮询来强制加了可能的cid或pindao_id等的url参数 ()
aaalinksss=get_qiangzhi_url_cang_main(aaalinksss,ndx_cid_var_namex,ndx_pindao_id_var_namex,ndx_zid_var_namex,ndx_viewid_var_namex,contbkkkk)
if nodoiiiiit=0 then
href_url_linksss=aaalinksss
href_url_linktaaa=aaalinksss
href_url_linksss=get_md5_htm_filename_by_aspfilename(href_url_linksss,contbkkkk,dothtm_or_html,1,aspfilenmazza)
if lcase(trim(aspfnmaaa))="index.asp" or lcase(trim(aspfnmaaa))="default.asp" then
href_url_linksss="index."&dothtm_or_html
end if
href_url_linksssaa=href_url_linksss
'含前缀目录的话在文件名前加上此前缀目录
if instr(1,href_url_link,"/",1)<>0 then
href_url_linksss=aspalujin&href_url_linksss
end if
before_urla=""
if href_url_index-1<>0 then
before_urla=mid(contb,1,href_url_index-1)
end if
after_urla=""
if href_url_index+href_url_len<=lencontb then
after_urla=mid(contb,href_url_index+href_url_len,lencontb-(href_url_index+href_url_len)+1)
end if
'去掉$1，$3的干扰
href_url_linksss=replace(href_url_linksss,"$1","#121#1#21#aspcpu")
href_url_linksss=replace(href_url_linksss,"$3","#121#3#21#aspcpu")
Set regEx2 = New RegExp '建立正则表达式。
regEx2.Pattern = href_reg2 '设置模式。
regEx2.IgnoreCase = True '设置是否区分字符大小写。
regEx2.Global = true
href_url_linkssszz=regEx2.Replace(href_url,"$1"&href_url_linksss&"$3") '执行
set regEx2=nothing
href_url_linkssszz=replace(href_url_linkssszz,"#121#1#21#aspcpu","$1")
href_url_linkssszz=replace(href_url_linkssszz,"#121#3#21#aspcpu","$3")
Cont=contbbofore&before_urla&href_url_linkssszz&after_urla
now_pos_in_asp=href_url_index+len(href_url_linkssszz)+len(contbbofore)
'----------------v2-----------
glbal_diff_pos=glbal_diff_pos+(len(href_url_linkssszz)-len(href_url))
'----------------v2-----------
need_href_array=need_href_array&"other_asp"&"$x$1$,$1$x$"&aspfilenma&"$x$1$,$1$x$"&href_url_linktaaa&"$x$1$,$1$x$"&href_url_linksssaa&"$$need_htmed_aspcpu121$$"
have_plusb=1
'----------------v2-----------
need_exeeet=1
'exit for
'----------------v2-----------
else
if guolv_files_like_goto_down_file(aspfnmaaa,is_qiye)=0 then
now_pos_in_asp=href_url_index+href_url_len+len(contbbofore)
end if
end if
end if
'----------------v2-----------
if need_exeeet=0 then
'----------------v2-----------
if have_asp=1 and guolv_files_like_goto_down_file(aspfnmaaa,is_qiye)=0 then
href_url_linkot=href_url_link
ConsultUrlxa=weburlaas
aaalinksss=lcase(trim(DefiniteUrlxxc(href_url_linkot,ConsultUrlxa)))
if left(aaalinksss,7)="http://" then
aaalinksss=mid(aaalinksss,8,len(aaalinksss)-8+1)
end if
aaalinksss=replace(aaalinksss,"\","/")
fin_posaa=-123
for iiaappss22=1 to len(aaalinksss)
if mid(aaalinksss,iiaappss22,1)="/" then
fin_posaa=iiaappss22
exit for
end if
next
if fin_posaa<>-123 then
aaalinksss=mid(aaalinksss,fin_posaa,len(aaalinksss)-fin_posaa+1)
end if
nodoiiiiit=0
lenouttppt=len(nd_weboutpppt)+1
sstestt=trim(lcase("/"&nd_weboutpppt))
if instr(1,aaalinksss,"/"&nd_weboutpppt&"/",1)=0 then
nodoiiiiit=1
end if
href_url_linksss=aaalinksss
'------- q--
if nodoiiiiit=0 then
href_url_linksss=get_qiangzhi_url_cang_main(href_url_linksss,ndx_cid_var_namex,ndx_pindao_id_var_namex,ndx_zid_var_namex,ndx_viewid_var_namex,contbkkkk)
href_url_linksssff=href_url_linksss
href_url_linksss=get_md5_htm_filename_by_aspfilename(href_url_linksss,contbkkkk,dothtm_or_html,1,aspfilenmazza)
if lcase(trim(aspfnmaaa))="index.asp" or lcase(trim(aspfnmaaa))="default.asp" then
href_url_linksss="index."&dothtm_or_html
end if
href_url_linksssaa=href_url_linksss
'含前缀目录的话在文件名前加上此前缀目录
if instr(1,href_url_link,"/",1)<>0 then
href_url_linksss=aspalujin&href_url_linksss
end if
before_urla=""
if href_url_index-1<>0 then
before_urla=mid(contb,1,href_url_index-1)
end if
after_urla=""
if href_url_index+href_url_len<=lencontb then
after_urla=mid(contb,href_url_index+href_url_len,lencontb-(href_url_index+href_url_len)+1)
end if
'去掉$1，$3的干扰
href_url_linksss=replace(href_url_linksss,"$1","#121#1#21#aspcpu")
href_url_linksss=replace(href_url_linksss,"$3","#121#3#21#aspcpu")
Set regEx2 = New RegExp '建立正则表达式。
regEx2.Pattern = href_reg2 '设置模式。
regEx2.IgnoreCase = True '设置是否区分字符大小写。
regEx2.Global = true
href_url_linkssszz=regEx2.Replace(href_url,"$1"&href_url_linksss&"$3") '执行
set regEx2=nothing
href_url_linkssszz=replace(href_url_linkssszz,"#121#1#21#aspcpu","$1")
href_url_linkssszz=replace(href_url_linkssszz,"#121#3#21#aspcpu","$3")
Cont=contbbofore&before_urla&href_url_linkssszz&after_urla
now_pos_in_asp=href_url_index+len(href_url_linkssszz)+len(contbbofore)
'----------------v2-----------
glbal_diff_pos=glbal_diff_pos+(len(href_url_linkssszz)-len(href_url))
'----------------v2-----------
need_href_array=need_href_array&"self_asp"&"$x$1$,$1$x$"&aspfilenma&"$x$1$,$1$x$"&href_url_linksssff&"$x$1$,$1$x$"&href_url_linksssaa&"$$need_htmed_aspcpu121$$"
'----------------v2-----------
need_exeeet=1
'exit for
'----------------v2-----------
else
if guolv_files_like_goto_down_file(aspfnmaaa,is_qiye)=0 then
now_pos_in_asp=href_url_index+href_url_len+len(contbbofore)
end if
end if
'-------end q--
else
if have_asp_other=0 and guolv_files_like_goto_down_file(aspfnmaaa,is_qiye)=0 then
'找到href链接,但是href里的链接同名同路径的.asp文件且不是同路径前缀的非同名.asp文件 ，或不是.asp文件,跳过
now_pos_in_asp=href_url_index+href_url_len+len(contbbofore)
end if
end if
'----------------v2-----------
if need_exeeet=0 then
'----------------v2-----------
if guolv_files_like_goto_down_file(aspfnmaaa,is_qiye)=1 then
now_pos_in_asp=href_url_index+href_url_len+len(contbbofore)
end if
'----------------v2-----------
end if
'----------------v2-----------
'----------------v2-----------
end if
'----------------v2-----------
Next
set regEx=nothing
'----------------v2-----------
'loop
'----------------v2-----------
if need_href_array<>"" and len(need_href_array)>22 then
need_href_array=left(need_href_array,len(need_href_array)-len("$$need_htmed_aspcpu121$$"))
end if
get_need_htmled_hrefArray_from_a_page_x_cid=Cont
End Function
function load_htm_ext_ming(is_qiye)
biao2="[ND_sys]"
if is_qiye=1 then
set rs22d=server.CreateObject("adodb.recordset")
rs22d.open "select top 1 * from "&biao2&" where type='webname_settings_qiye'",conn2,1,1
else
set rs22d=server.CreateObject("adodb.recordset")
rs22d.open "select top 1 * from "&biao2&" where type='webname_settings'",conn2,1,1
end if
ddd1d=rs22d("data")
rs22d.close
set rs22d=nothing
dddd12d=split(ddd1d,"|")
hhhta=cstr(dddd12d(4))
hhhtax=cstr(dddd12d(5))
htm_ext_ming=mid(hhhtax,2,len(hhhtax))
End Function
Function Re_Replace(retxt)
Re_Replace = Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(retxt, "[", "\["), "]", "\]"), "(", "\("), ")", "\)"), "$", "\$"), "^", "\^"), "{", "\{"), "}", "\}"), "+", "\+"), ".", "\."), "<", "\<"), ">", "\>"), "-", "\-")
End Function
Function GetCode(str,regstr)
set Reg= new RegExp
Reg.IgnoreCase = True
Reg.Global = true
Reg.Pattern =regstr
Set Matches = Reg.Execute(str)
For Each Match in Matches
GetCode=Match.SubMatches(0)
exit for
next
end function
iscrtfile="$$iscrtfile$$"
w_web_config_template="$$w_web_config_template$$"
w_files_config="$$w_files_config$$"
w_files_config_template="$$w_files_config_template$$"
function load_files_all_type(is_qiye)
is_cms=1
if is_qiye=1 then is_cms=0
set rs112=server.CreateObject("adodb.recordset")
if is_cms=1 then
rs112.open "select * from ND_templates_folder_reg where is_default_template=true",conn2,1,1
else
rs112.open "select * from ND_templates_folder_reg_qiye where is_default_template=true",conn2,1,1
end if
if rs112.eof then
replace_webfiles_names=str
exit function
else
ppath="templates/"&rs112("templates_folder_path_name")&"/"
scrt_ff="../"&ppath&iscrtfile
use_http_url=0
use_http_post=0
set fileaw=new Cls_FSO
set filebw=new DosAsp
if fileaw.ReportFileStatus(server.mappath(scrt_ff))=-1 then
'模板目录下不存在"&iscrtfile&"安装脚本文件
sconts=loadfile("../inc/"&w_web_config_template)
call SaveXMLDocument_newindexc(scrt_ff,sconts,is_cms)
scrt_ff="../"&ppath&w_files_config
sconts=loadfile("../inc/"&w_files_config_template)
call SaveXMLDocument(scrt_ff,sconts)
else
'模板目录下存在"&iscrtfile&"安装脚本文件
xm_d_c=ReadXMLDocument(scrt_ff,"all_web_file_name_and_type_config")
scrt_fff="../"&ppath&xm_d_c
if fileaw.ReportFileStatus(server.mappath(scrt_fff))=-1 then
scrt_ff="../"&ppath&xm_d_c
sconts=loadfile("../inc/"&w_files_config_template)
call SaveXMLDocument(scrt_ff,sconts)
end if
end if
ppath="templates/"&rs112("templates_folder_path_name")&"/"
scrt_ff="../"&ppath&iscrtfile
xm_d_c=ReadXMLDocument(scrt_ff,"all_web_file_name_and_type_config")
scrt_ff="../"&ppath&xm_d_c
set aasc=ReadXMLDocument_nodes(scrt_ff,"files/file_reg")
set loaded_file_types=aasc
end if
rs112.close
set rs112=nothing
end function
function get_file_type(filenamea)
get_file_type=""
filenamea=lcase(trim(filenamea))
for aiaa=0 to loaded_file_types.length-1
aassaa=trim(rep_xml_br(loaded_file_types(aiaa).selectSingleNode("filetype").text))
bbssbb=trim(rep_xml_br(loaded_file_types(aiaa).selectSingleNode("filename").text))
bbssbb=lcase(trim(bbssbb))
if bbssbb=filenamea then
get_file_type=lcase(aassaa)
end if
next
end function
Public Function ReadXMLDocument(strXMLFile,strNode)
if use_http_url=1 then
sssurh=ReadXMLDocumenthttp(strXMLFile,strNode)
ReadXMLDocument=sssurh
exit function
end if
'Set XmlNode = XmlDoc.documentElement.selectSingleNode("rs:data/z:row[@id=0]")
'Wss_IsUsed = Newasp.ChkNumeric(XmlNode.getAttribute("wss_isused"))
If strXMLFile = "" Then Exit Function
If InStr(strXMLFile, ":") = 0 Then strXMLFile = Server.MapPath(strXMLFile)
Set oXMLDom = Server.CreateObject("Msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
'oXMLDom.appendChild(oXMLDom.createElement("xml"))
'response.write oXMLDom.Load("<root><b></b></root>")
If oXMLDom.Load(strXMLFile) Then
If strNode = "" Or strNode = "0" Then
ReadXMLDocument = oXMLDom.xml
Else
ReadXMLDocument = trim(rep_xml_br(oXMLDom.documentElement.selectSingleNode(strNode).text))
End If
Else
ReadXMLDocument = ""
End If
Set oXMLDom = Nothing
If Err.Number <> 0 Then
Err.Clear
end if
End Function
Public Function ReadXMLDocumentx(strXMLFile,strNode)
if use_http_url=1 then
sssurh=ReadXMLDocumentxhttp(strXMLFile,strNode)
ReadXMLDocumentx=sssurh
exit function
end if
'Set XmlNode = XmlDoc.documentElement.selectSingleNode("rs:data/z:row[@id=0]")
'Wss_IsUsed = Newasp.ChkNumeric(XmlNode.getAttribute("wss_isused"))
If strXMLFile = "" Then Exit Function
If InStr(strXMLFile, ":") = 0 Then strXMLFile = Server.MapPath(strXMLFile)
Set oXMLDom = Server.CreateObject("Msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
'oXMLDom.appendChild(oXMLDom.createElement("xml"))
'response.write oXMLDom.Load("<root><b></b></root>")
If oXMLDom.Load(strXMLFile) Then
If strNode = "" Or strNode = "0" Then
ReadXMLDocumentx = oXMLDom.xml
Else
set ReadXMLDocumentx = oXMLDom.documentElement.selectSingleNode(strNode)
End If
Else
ReadXMLDocumentx = ""
End If
Set oXMLDom = Nothing
If Err.Number <> 0 Then
Err.Clear
end if
End Function
Public Function ReadXMLDocument_nodes(strXMLFile,strNode)
'Set XmlNode = XmlDoc.documentElement.selectSingleNode("rs:data/z:row[@id=0]")
'Wss_IsUsed = Newasp.ChkNumeric(XmlNode.getAttribute("wss_isused"))
'为了发现无效网址请加下面这行
On Error Resume Next
if use_http_url=1 then
set sssurh=ReadXMLDocumenthttp_nodes(strXMLFile,strNode)
if http_url_err=1 or err.number<>0 then
ReadXMLDocumenthttp_nodes=""
exit function
end if
set ReadXMLDocument_nodes=sssurh
exit function
end if
If strXMLFile = "" Then Exit Function
If InStr(strXMLFile, ":") = 0 Then strXMLFile = Server.MapPath(strXMLFile)
Set oXMLDom = Server.CreateObject("Msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
'oXMLDom.appendChild(XMLDom.createElement("xml"))
If oXMLDom.Load(strXMLFile) Then
If strNode = "" Or strNode = "0" Then
ReadXMLDocument_nodes = oXMLDom.xml
Else
set ReadXMLDocument_nodes = oXMLDom.documentElement.selectNodes(strNode)
End If
Else
ReadXMLDocument_nodes = ""
End If
Set oXMLDom = Nothing
If Err.Number <> 0 Then Err.Clear
End Function
' ==========================.ex================================================
' Sub ReponseData()
' If Act <> "getinfo" Then
' XmlDoc.loadxml "<root><appid>dvbbs</appid><status>0</status><body><message/></body></root>"
' End If
' XmlDoc.documentElement.selectSingleNode("appid").text = "newasp"
' If API_Debug And Act <> "reguser" Then
' XmlDoc.documentElement.selectSingleNode("status").text = 0
' Messenge = ""
' Else
' XmlDoc.documentElement.selectSingleNode("status").text = status
' End If
' XmlDoc.documentElement.selectSingleNode("body/message").text = ""
' Set Node = XmlDoc.createCDATASection(Replace(Messenge,"]]>","]]>"))
' XmlDoc.documentElement.selectSingleNode("body/message").appendChild(Node)
' Response.Clear
' Response.ContentType="text/xml"
' Response.CharSet="gb2312"
' Response.Write "<?xml version=""1.0"" encoding=""gb2312""?>"&vbNewLine
' Response.Write XmlDoc.documentElement.XML
'End Sub
' Dom.documentElement.selectSingleNode("setting/checkuser[@usergroupid="&usergroupid&"]") is Nothing Then
' If Not Node is Nothing Then
' Set Node=Dom.documentElement.selectSingleNode("setting/nocheck[username='"&Dvbbs.Checkstr(Request("username"))&"']")
' If Node is Nothing Then
' For Each node in Dom.documentElement.selectNodes("setting")
' Node.selectSingleNode("nocheck").appendChild(Dom.createNode(1,"username","")).text=Request("username")
' Next
' End If
' End If
' If position < Node.length +1 Then
' Dom.documentElement.removeChild(Node(position-1))
' End If
' For each boardid in Application(Dvbbs.CacheName&"_boardlist").documentElement.selectNodes("board/@boardid")
' Set Node =XMLDom.documentElement.selectNodes("result[@boardid="& boardid.text &"]")
' ==========================.ex================================================
Public Function XMLEncode(ByVal str)
Dim i
str = Replace(str,"&","&")
For i = 0 to 31
str = Replace(str,Chr(i),"&#"&i&";")
Next
For i = 95 to 96
str = Replace(str,Chr(i),"&#"&i&";")
Next
XMLEncode = str
End Function
Public Function XMLDecode(ByVal str)
Dim i
str = Replace(str,"&","&")
For i = 0 to 31
str = Replace(str,"&#"&i&";",Chr(i))
Next
For i = 95 to 96
str = Replace(str,"&#"&i&";",Chr(i))
Next
XMLDecode = str
End Function
nd_fang_caiji_rand_str_x="$$ndxx_fang_caiji_rand_str_x$$"
'*************************************************************************************************
'Function get_md5_htm_filename_by_aspfile(aspfilename,........)
'自动排序asp文件后的url参数名并生成其md5后的htm文件名，
'对于多个page565656528之类的url参数名，按page565656528之类在asp网页里出现的次序来排序，
'并且page565656528之类的url参数名 排在 url参数名集合最后几位
'page565656528=3记为pagerndaspcpuvar0=3，来放进url参数名集合里来生成其md5后的htm文件名，
'page565656528不用放进，因为它的565656528是随机的
'注意aaaa/wwss.asp?cid=22&id=1这样的含目录的asp文件名的处理，目录名也要包含进去来算md5后的htm文件名
'所有asp文件名都lcase和trim处理后再算md5后的htm文件名
',另外,由于用扫描cid方式扫描分类页时加了 频道id参数:id,故无论真实的链到分类页的链接里有无加 频道id参数:id,
'都强制加 频道id参数:id 到 真实的链到分类页的链接里,以使按url参数名生成其md5后的htm文件名 能统一起来
'*************************************************************************************************
Function get_md5_htm_filename_by_aspfilename(aspfilename,aspfile_output_htmlcontent,dothtm_or_html,is_md5ed,qianzhui_lujin)
redim canming(999)
redim canvalue(999)
redim minvalue_index(999)
redim canming_temp(999)
redim canvalue_temp(999)
aspfilename=trim(lcase(aspfilename))
if instr(1,aspfilename,"?",1)<>0 and len(aspfilename)>=instr(1,aspfilename,"?",1)+1 then
urlcan=mid(aspfilename,instr(1,aspfilename,"?",1)+1,len(aspfilename)-instr(1,aspfilename,"?",1))
else
urlcan=""
end if
if instr(1,aspfilename,"?",1)<>0 then
sfilename=left(aspfilename,instr(1,aspfilename,"?",1)-1)
else
sfilename=aspfilename
end if
strUrl=lcase(JoinChara(sfilename))
Fy_Url1=urlcan
Fy_a1=split(Fy_Url1,"&")
redim canming(ubound(Fy_a1)+1)
redim canvalue(ubound(Fy_a1)+1)
lenttt=ubound(Fy_a1)
for Fy_x1=0 to ubound(Fy_a1)
if instr(1,Fy_a1(Fy_x1),"=",1)=0 then
if is_md5ed=1 then
get_md5_htm_filename_by_aspfilename=md5(lcase(aspfilename)&nd_fang_caiji_rand_str_x)&"."&dothtm_or_html
else
get_md5_htm_filename_by_aspfilename=lcase(aspfilename)
end if
exit function
else
if instr(Fy_a1(Fy_x1),"=")=len(Fy_a1(Fy_x1)) then
Fy_v =""
else
Fy_v = mid(Fy_a1(Fy_x1),instr(Fy_a1(Fy_x1),"=")+1,len(Fy_a1(Fy_x1)))
end if
Fy_Cs_name= left(Fy_a1(Fy_x1),instr(Fy_a1(Fy_x1),"=")-1)
canming(Fy_x1)=Fy_Cs_name
canvalue(Fy_x1)=Fy_v
end if
Next
'排序算法:
redim minvalue_index(ubound(Fy_a1)+1)
for isssaa=0 to lenttt
minvalue_index(isssaa)=-123
next
redim pagevvvar(ubound(Fy_a1)+1)
redim pagevvvar_v(ubound(Fy_a1)+1)
pvar_pos=0
redim pagevvvar_minindex(ubound(Fy_a1)+1)
for isssaa2=0 to lenttt
pagevvvar_minindex(isssaa2)=-123
next
'----------paixu code---------------
for nowmin=0 to lenttt
firstrun=1
for mppp=0 to lenttt
'----------排除排过了的元素
need_break=0
for nowmintest=0 to nowmin
if minvalue_index(nowmintest)=mppp then
need_break=1
exit for
end if
next
'--------end 排除排过了的元素
if need_break=0 then
if firstrun=1 then
firstrun=0
minvalue_index(nowmin)=mppp
end if
end if
'----------排除page9256572330之类
if need_break=0 then
if len(canming(minvalue_index(nowmin)))=14 and lcase(left(canming(minvalue_index(nowmin)),4))="page" then
tstdd=mid(canming(minvalue_index(nowmin)),5,10)
href_reg22="[0-9]{10}"
Set regEx22 = New RegExp '建立正则表达式。
regEx22.Pattern = href_reg22 '设置模式。
regEx22.IgnoreCase = True '设置是否区分字符大小写。
regEx22.Global = true
if regEx22.test(tstdd)=true then
need_break=1
need_jilup=1
for piiis=0 to pvar_pos-1
if lcase(pagevvvar(piiis))=lcase(canming(minvalue_index(nowmin))) then
need_jilup=0
exit for
end if
next
if need_jilup=1 then
pagevvvar(pvar_pos)=canming(minvalue_index(nowmin))
pagevvvar_v(pvar_pos)=canvalue(minvalue_index(nowmin))
pvar_pos=pvar_pos+1
end if
end if
set regEx22=nothing
end if
if len(canming(mppp))=14 and lcase(left(canming(mppp),4))="page" then
tstdd=mid(canming(mppp),5,10)
href_reg22="[0-9]{10}"
Set regEx22 = New RegExp '建立正则表达式。
regEx22.Pattern = href_reg22 '设置模式。
regEx22.IgnoreCase = True '设置是否区分字符大小写。
regEx22.Global = true
if regEx22.test(tstdd)=true then
need_break=1
need_jilup=1
for piiis=0 to pvar_pos-1
if lcase(pagevvvar(piiis))=lcase(canming(mppp)) then
need_jilup=0
exit for
end if
next
if need_jilup=1 then
pagevvvar(pvar_pos)=canming(mppp)
pagevvvar_v(pvar_pos)=canvalue(mppp)
pvar_pos=pvar_pos+1
end if
end if
set regEx22=nothing
end if
end if
'--------end 排除page9256572330之类
if need_break=0 then
'-------对于含多个字符的字符串的 字符串排序 先后的比较，从低位字符比较起，直到最高位字符
for char_wei=1 to 999
if len(canming(minvalue_index(nowmin)))>=char_wei and len(canming(mppp))<char_wei then
minvalue_index(nowmin)=mppp
exit for
end if
if len(canming(minvalue_index(nowmin)))<char_wei and len(canming(mppp))>=char_wei then
exit for
end if
if len(canming(minvalue_index(nowmin)))<char_wei and len(canming(mppp))<char_wei and len(canming(minvalue_index(nowmin)))<len(canming(mppp)) then
exit for
end if
if len(canming(minvalue_index(nowmin)))<char_wei and len(canming(mppp))<char_wei and len(canming(minvalue_index(nowmin)))>len(canming(mppp)) then
minvalue_index(nowmin)=mppp
exit for
end if
if len(canming(minvalue_index(nowmin)))<char_wei and len(canming(mppp))<char_wei and len(canming(minvalue_index(nowmin)))=len(canming(mppp)) then
exit for
end if
if len(canming(minvalue_index(nowmin)))>=char_wei and len(canming(mppp))>=char_wei then
'不能判断，执行下面的代码继续进一步判断
end if
if asc(lcase(mid(canming(mppp),char_wei,1)))<asc(lcase(mid(canming(minvalue_index(nowmin)),char_wei,1))) then
minvalue_index(nowmin)=mppp
exit for
end if
if asc(lcase(mid(canming(mppp),char_wei,1)))>asc(lcase(mid(canming(minvalue_index(nowmin)),char_wei,1))) then
exit for
end if
if asc(lcase(mid(canming(mppp),char_wei,1)))=asc(lcase(mid(canming(minvalue_index(nowmin)),char_wei,1))) then
end if
next
'----end---对于含多个字符的字符串的 字符串排序 先后的比较，从低位字符比较起，直到最高位字符
end if
next
next
'----------end paixu code-------
for ippsxxa=0 to pvar_pos-1
next
if pvar_pos-1>=0 then
'page123123123,page5634534534之类的排序code:
'page123123123,page5634534534之类的排序code:
'----------paixu code2---------------
for nowmin2=0 to pvar_pos-1
firstrun=1
for mppp2=0 to pvar_pos-1
'----------排除排过了的元素 2
need_break=0
for nowmintest2=0 to nowmin2
if pagevvvar_minindex(nowmintest2)=mppp2 then
need_break=1
exit for
end if
next
'--------end 排除排过了的元素 2
if need_break=0 then
if firstrun=1 then
firstrun=0
pagevvvar_minindex(nowmin2)=mppp2
end if
end if
if need_break=0 then
poshtmla=instr(1,aspfile_output_htmlcontent,pagevvvar(mppp2),1)
poshtmlb=instr(1,aspfile_output_htmlcontent,pagevvvar(pagevvvar_minindex(nowmin2)),1)
if poshtmla<poshtmlb then
pagevvvar_minindex(nowmin2)=mppp2
end if
end if
next
next
'----------end paixu code2---------------
redim pagevvvar_temp(pvar_pos)
redim pagevvvar_v_temp(pvar_pos)
for azasxx=0 to pvar_pos-1
pagevvvar_temp(azasxx)=pagevvvar(azasxx)
pagevvvar_v_temp(azasxx)=pagevvvar_v(azasxx)
Next
for azasxxb=0 to pvar_pos-1
pagevvvar(azasxxb)=pagevvvar_temp(pagevvvar_minindex(azasxxb))
pagevvvar_v(azasxxb)=pagevvvar_v_temp(pagevvvar_minindex(azasxxb))
Next
end if
for Fy_x1a=0 to lenttt
canming_temp(Fy_x1a)=canming(Fy_x1a)
canvalue_temp(Fy_x1a)=canvalue(Fy_x1a)
Next
for Fy_x1aa=0 to lenttt
canming(Fy_x1aa)=canming_temp(minvalue_index(Fy_x1aa))
canvalue(Fy_x1aa)=canvalue_temp(minvalue_index(Fy_x1aa))
Next
if pvar_pos-1>=0 then
for Fy_x1aass=(lenttt-pvar_pos+1) to lenttt
if is_md5ed=1 then
canming(Fy_x1aass)="pagerndaspcpuvar"&cstr(Fy_x1aass-(lenttt-pvar_pos+1))
else
canming(Fy_x1aass)=pagevvvar(Fy_x1aass-(lenttt-pvar_pos+1))
end if
canvalue(Fy_x1aass)=pagevvvar_v(Fy_x1aass-(lenttt-pvar_pos+1))
Next
end if
for Fy_x1aaa=0 to lenttt
Fy_Cs_name=trim(lcase(canming(Fy_x1aaa)))
Fy_v=trim(lcase(canvalue(Fy_x1aaa)))
if trim(Fy_Cs_name)<>"" then
strUrl=JoinChara(strUrl)
strUrl=strUrl&Fy_Cs_name&"="&Fy_v
end if
next
'qianzhui_lujin=lcase(trim(qianzhui_lujin))
qianzhui_lujin=""
if is_md5ed=1 then
get_md5_htm_filename_by_aspfilename=md5(qianzhui_lujin&strUrl&nd_fang_caiji_rand_str_x)&"."&dothtm_or_html
else
get_md5_htm_filename_by_aspfilename=qianzhui_lujin&strUrl
end if
End Function
function rep_xml_br(str)
str=replace(str,vbcrlf,"")
str=replace(str,chr(10),"")
str= Replace(str, CHR(13), "")
str= Replace(str, CHR(9), "")
rep_xml_br=str
End Function
function chk_web_creater_script_ver(str)
if lcase(trim(rep_xml_br(str)))="newdsoft_web_creater_script ver 8.5.1" then
chk_web_creater_script_ver=1
else
chk_web_creater_script_ver=0
end if
end function
function chk_web_creater_can_install_ver(str)
if lcase(trim(rep_xml_br(str)))=lcase(trim(ver)) then
chk_web_creater_can_install_ver=1
else
chk_web_creater_can_install_ver=0
end if
end function
function chk_bef_ver(xml_path,filename)
chk_bef_ver=1
xm_d_ver=ReadXMLDocument(xml_path,"ver")
if chk_web_creater_script_ver(xm_d_ver)=0 then
errrstrra=filename&"的版本 不受本系统里的脚本解释器支持，或则"&filename&"文件已损坏<br>"
chk_bef_ver=0
exit function
end if
set xm_d_zhic=ReadXMLDocument_nodes(xml_path,"can_install_in_what_sys_ver/v")
can_inst=0
v_list_i=""
for aia=0 to xm_d_zhic.length-1
if chk_web_creater_can_install_ver(xm_d_zhic(aia).text)=1 then
can_inst=1
end if
v_list_i=v_list_i&xm_d_zhic(aia).text&" ,"
next
v_list_i=left(v_list_i,len(v_list_i)-1)
if can_inst=0 then
errrstrra="此安装脚本("&filename&")不能在 "&ver&"版本 的新动软网站系统里执行，因为本系统的版本不在此模板支持的版本列表内,此安装脚本支持的系统版本列表如下:"&v_list_i
chk_bef_ver=0
exit function
end if
end function
fssoo_nd_var_str_x_customx="$$xxxx_d_soft_complie$$fssoo_nd_var_str_x_customx$"
Class Cls_FSO
Public objFSO
Private Sub Class_Initialize()
Set objFSO = Server.CreateObject(fssoo_nd_var_str_x_customx)
End Sub
Private Sub class_terminate()
Set objFSO = Nothing
End Sub
'=======文件操作========
'取文件大小
Public Function GetFileSize(FileName)
Dim f
If ReportFileStatus(FileName) = 1 Then
Set f = objFSO.Getfile(FileName)
GetFileSize = f.Size
Else
GetFileSize = -1
End if
End Function
'文件删除
Public Function deleteAFile(FileSpec)
If ReportFileStatus(FileSpec) = 1 Then
objFSO.deleteFile(FileSpec)
deleteAFile = 1
Else
deleteAFile = -1
End if
End Function
'显示文件列表
Public Function ShowFileList(FolderSpec)
Dim f, f1, fc, s
If ReportFolderStatus(FolderSpec) = 1 Then
Set f = objFSO.GetFolder(FolderSpec)
Set fc = f.Files
For Each f1 in fc
s = s & f1.name
s = s & "|"
Next
ShowFileList = s
Else
ShowFileList = -1
End if
End Function
'文件复制
Public Function CopyAFile(SourceFile, DestinationFile)
Dim MyFile
If ReportFileStatus(SourceFile) = 1 Then
Set MyFile = objFSO.GetFile(SourceFile)
MyFile.Copy (DestinationFile)
CopyAFile = 1
Else
CopyAFile = -1
End if
End Function
'文件移动
Public Function MoveAFile(SourceFile,DestinationFile)
If ReportFileStatus(SourceFile) = 1 And ReportFileStatus(DestinationFileORPath) = -1 Then
objFSO.MoveFile SourceFile,DestinationFileORPath
MoveAFile = 1
Else
MoveAFile = -1
End if
End Function
'文件是否存在？
Public Function ReportFileStatus(FileName)
Dim msg
msg = -1
If (objFSO.FileExists(FileName)) Then
msg = 1
Else
msg = -1
End If
ReportFileStatus = msg
End Function
'文件创建日期
Public Function ShowDatecreated(FileSpec)
Dim f
If ReportFileStatus(FileSpec) = 1 Then
Set f = objFSO.GetFile(FileSpec)
ShowDatecreated = f.Datecreated
Else
ShowDatecreated = -1
End if
End Function
'文件属性
Public Function GetAttributes(FileName)
Dim f
Dim strFileAttributes
If ReportFileStatus(FileName) = 1 Then
Set f = objFSO.GetFile(FileName)
select Case f.attributes
Case 0 strFileAttributes = "普通文件。没有设置任何属性。 "
Case 1 strFileAttributes = "只读文件。可读写。 "
Case 2 strFileAttributes = "隐藏文件。可读写。 "
Case 4 strFileAttributes = "系统文件。可读写。 "
Case 16 strFileAttributes = "文件夹或目录。只读。 "
Case 32 strFileAttributes = "上次备份后已更改的文件。可读写。 "
Case 1024 strFileAttributes = "链接或快捷方式。只读。 "
Case 2048 strFileAttributes = " 压缩文件。只读。"
End select
GetAttributes = strFileAttributes
Else
GetAttributes = -1
End if
End Function
'最后一次访问/最后一次修改时间
Public Function ShowFileAccessInfo(FileName,InfoType)
'//功能：显示文件创建时信息
'//形参：文件名,信息类别
'// 1 -----创建时间
'// 2 -----上次访问时间
'// 3 -----上次修改时间
'// 4 -----文件路径
'// 5 -----文件名称
'// 6 -----文件类型
'// 7 -----文件大小
'// 8 -----父目录
'// 9 -----根目录
Dim f, s
If ReportFileStatus(FileName) = 1 then
Set f = objFSO.GetFile(FileName)
select Case InfoType
Case 1 s = f.Datecreated
Case 2 s = f.DateLastAccessed
Case 3 s = f.DateLastModified
Case 4 s = f.Path
Case 5 s = f.Name
Case 6 s = f.Type
Case 7 s = f.Size
Case 8 s = f.ParentFolder
Case 9 s = f.RootFolder
End select
ShowFileAccessInfo = s
ELse
ShowFileAccessInfo = -1
End if
End Function
'写文本文件
Public Function WriteTxtFile(FileName,TextStr,WriteORAppendType)
Const ForReading = 1, ForWriting = 2 , ForAppending = 8
Dim f, m
select Case WriteORAppendType
Case 1: '文件进行写操作
Set f = objFSO.OpenTextFile(FileName, ForWriting, True)
f.Write TextStr
f.Close
If ReportFileStatus(FileName) = 1 then
WriteTxtFile = 1
Else
WriteTxtFile = -1
End if
Case 2: '文件末尾进行写操作
If ReportFileStatus(FileName) = 1 then
Set f = objFSO.OpenTextFile(FileName, ForAppending)
f.Write TextStr
f.Close
WriteTxtFile = 1
Else
WriteTxtFile = -1
End if
End select
End Function
'读文本文件
Public Function ReadTxtFile(FileName)
Const ForReading = 1, ForWriting = 2
Dim f, m
If ReportFileStatus(FileName) = 1 then
Set f = objFSO.OpenTextFile(FileName, ForReading)
m = f.ReadLine
ReadTxtFile = m
f.Close
Else
ReadTxtFile = -1
End if
End Function
'建立文本文件
'=======目录操作========
'取目录大小
Public Function GetFolderSize(FolderName)
Dim f
If ReportFolderStatus(FolderName) = 1 Then
Set f = objFSO.GetFolder(FolderName)
GetFolderSize = f.Size
Else
GetFolderSize = -1
End if
End Function
'创建的文件夹
Public Function createFolderDemo(FolderName)
Dim f
If ReportFolderStatus(Folderspec) = 1 Then
createFolderDemo = -1
Else
Set f = objFSO.createFolder(FolderName)
createFolderDemo = 1
End if
End Function
'目录删除
Public Function deleteAFolder(Folderspec)
Response.write Folderspec
If ReportFolderStatus(Folderspec) = 1 Then
objFSO.deleteFolder (Folderspec)
deleteAFolder = 1
Else
deleteAFolder = -1
End if
End Function
'显示目录列表
Public Function ShowFolderList(FolderSpec)
Dim f, f1, fc, s
If ReportFolderStatus(FolderSpec) = 1 Then
Set f = objFSO.GetFolder(FolderSpec)
Set fc = f.SubFolders
For Each f1 in fc
s = s & f1.name
s = s & "|"
Next
ShowFolderList = s
Else
ShowFolderList = -1
End if
End Function
'目录复制
Public Function CopyAFolder(SourceFolder,DestinationFolder)
objFSO.CopyFolder SourceFolder,DestinationFolder
CopyAFolder = 1
CopyAFolder = -1
End Function
'目录进行移动
Public Function MoveAFolder(SourcePath,DestinationPath)
If ReportFolderStatus(SourcePath)=1 And ReportFolderStatus(DestinationPath)=0 Then
objFSO.MoveFolder SourcePath, DestinationPath
MoveAFolder = 1
Else
MoveAFolder = -1
End if
End Function
'判断目录是否存在
Public Function ReportFolderStatus(fldr)
Dim msg
msg = -1
If (objFSO.FolderExists(fldr)) Then
msg = 1
Else
msg = -1
End If
ReportFolderStatus = msg
End Function
'目录创建时信息
Public Function ShowFolderAccessInfo(FolderName,InfoType)
'//功能：显示目录创建时信息
'//形参：目录名,信息类别
'// 1 -----创建时间
'// 2 -----上次访问时间
'// 3 -----上次修改时间
'// 4 -----目录路径
'// 5 -----目录名称
'// 6 -----目录类型
'// 7 -----目录大小
'// 8 -----父目录
'// 9 -----根目录
Dim f, s
If ReportFolderStatus(FolderName) = 1 then
Set f = objFSO.GetFolder(FolderName)
select Case InfoType
Case 1 s = f.Datecreated
Case 2 s = f.DateLastAccessed
Case 3 s = f.DateLastModified
Case 4 s = f.Path
Case 5 s = f.Name
Case 6 s = f.Type
Case 7 s = f.Size
Case 8 s = f.ParentFolder
Case 9 s = f.RootFolder
End select
ShowFolderAccessInfo = s
ELse
ShowFolderAccessInfo = -1
End if
End Function
'遍历目录
Public Function DisplayLevelDepth(pathspec)
Dim f, n ,Path
Set f = objFSO.GetFolder(pathspec)
If f.IsRootFolder Then
DisplayLevelDepth ="指定的文件夹是根文件夹。"&RootFolder
Else
Do Until f.IsRootFolder
Path = Path & f.Name &"<br>"
Set f = f.ParentFolder
n = n + 1
Loop
DisplayLevelDepth ="指定的文件夹是嵌套级为 " & n & " 的文件夹。<br>" & Path
End If
End Function
'========磁盘操作========
'驱动器是否存在？
Public Function ReportDriveStatus(drv)
Dim msg
msg = -1
If objFSO.DriveExists(drv) Then
msg = 1
Else
msg = -1
End If
ReportDriveStatus = msg
End Function
'可用的返回类型包括 FAT、NTFS 和 CDFS。
Public Function ShowFileSystemType(drvspec)
Dim d
If ReportDriveStatus(drvspec) = 1 Then
Set d = objFSO.GetDrive(drvspec)
ShowFileSystemType = d.FileSystem
ELse
ShowFileSystemType = -1
End if
End Function
End Class
'----------------------------------------------------------------------
'转发时请保留此声明信息,这段声明不并会影响你的速度!
'******************* DOSASP类 V1.01 ************************************
'作者:九五
'----------------------------------------------------------------------
'----------------------------------------------------------------------
Class DosAsp
Public fso
Private Sub Class_Initialize
Set fso=Server.createobject(fssoo_nd_var_str_x_customx)
End Sub
'-----------------------------
Public Function Exists(Path) '判断文件目录是否存在
Exists=fso.FileExists(Path)
if not(Exists) then
Exists=fso.FolderExists(Path)
end if
End Function
'------------------------------
Public Function Del(FullPath) '删除文件
Del=False
If Exists(FullPath) then
On error resume next
fso.DeleteFile(FullPath)
if err.number=0 then
Del=True
End if
End If
End Function
'------------------------------
Public Function Copy(SourceFile,DestinationFile)'复制文件
Dim MyFile
If ReportFileStatus(SourceFile) = 1 Then
Set MyFile = fso.GetFile(SourceFile)
MyFile.Copy (DestinationFile)
CopyAFile = 1
Else
CopyAFile = -1
End If
End Function
'------------------------------
Public Function Md(FullPath) '建立目录
If Exists(FullPath) Then
md = false
Else
fso.CreateFolder(FullPath)'此处可用set获得目录路径
md = true
End If
End Function
'------------------------------------
Public Function Rd(FullPath) '删除目录
on error resume next
If not(Exists(FullPath)) Then
' Rd = false
Rd = true
Else
err.clear
fso.DeleteFolder(FullPath)
if err.number<>0 then
Rd = false
else
Rd = true
end if
End If
End Function
'------------------------------------
Public Function Cd(Path) '切换目录
If exists(Path) then
set Cd=fso.GetFolder(Path)
End If
End Function
'----------------------------------
Public Function Ren(MyOld,MyNew) '文件目录重命名
Ren=False
Dim File
If exists(MyOld) then
if instr(MyNew,"\")>0 then
MyNew = Right(s, Len(s) - (InStrRev(MyNew, "\", -1, vbTextCompare)))
end if
on error resume next
set File=fso.GetFile(MyOld)
File.Name=MyNew
if err.number=0 then
Ren=True
end if
err.clear
End If
'```````````````````````````````````````````````
if Ren=False then
If exists(MyOld) then
if instr(MyNew,"\")>0 then
Dir2 = Right(s, Len(s) - (InStrRev(MyNew, "\", -1, vbTextCompare)))
end if
on error resume next
set mDir=Cd(MyOld)
mDir.Name=MyNew
if err.number=0 then
Ren=True
end if
End If
end if
End Function
'------------------------------------
Public Function Dir(Path) '列目录
Dim f, f1, fc, s,flag
If Exists(Path) Then
Set f = Cd(Path)
Set fc = f.SubFolders
flag=0
For Each f1 in fc
flag=flag+1
if flag<>1 then
s = s & "|"
end if
s = s & f1.name
Next
Flag=0
set fc=f.Files
For Each f1 in fc
flag=flag+1
if len(s)=0 then
if flag<>1 then
s = s & "|"
end if
else
s=s & "|"
end if
s = s & f1.name
Next
Dir = s
Else
Dir = False
End If
End Function
Public Sub MsgBox(MyStr)
Response.write "<Script language=vbscript> MsgBox("""
Response.write MyStr
Response.write """)</Script>"
End Sub
Private Sub Class_Terminate
if isobject(fso) then
set fso=nothing
end if
End Sub
End Class
' 创建文件,支持无限目录
'--------------------'
function createfile(byval path,byval body,byval check)
dim fso,subpath,pathdeep,i,cachepath
path = replace(path,"/","\")
path = replace(path,"\\","\")
path = replace(path,"\\","\")
path = replace(server.mappath(path),server.mappath("/"),"")'从根目录计算了~~
cachepath = replace(replace(replace(replace(replace(path,"/",""),"\",""),"-",""),"_",""),",","")
if getcache(cachepath) = "true" then
if not savefile(body,path) then
' 创建文件夹
if lcase(cstr(check)) = "true" then
' 创建目录
subpath = split(path,"\")
pathdeep = pathdeep & server.mappath("/")
for i = 1 to ubound(subpath) - 1
pathdeep = pathdeep & "/" & subpath(i)
if not isobject(fso) then set fso = server.createobject(fssoo_nd_var_str_x_customx)
if not fso.folderexists(pathdeep) then fso.createfolder pathdeep
next
if isobject(fso) then set fso = nothing
setcache cachepath,"true"
end if
' 创建文件
createfile = savefile(body,path)
end if
else
' 创建文件夹
if lcase(cstr(check)) = "true" then
' 创建目录
subpath = split(path,"\")
pathdeep = pathdeep & server.mappath("/")
for i = 1 to ubound(subpath) - 1
pathdeep = pathdeep & "/" & subpath(i)
if not isobject(fso) then set fso = server.createobject(fssoo_nd_var_str_x_customx)
if not fso.folderexists(pathdeep) then fso.createfolder pathdeep
next
if isobject(fso) then set fso = nothing
setcache cachepath,"true"
end if
' 创建文件
createfile = savefile(body,path)
end if
end function
' 删除文件夹
'--------------------'
function deletefolder(byval path)
dim fso
path = replace(path,"/","\")
path = replace(path,"\\","\")
path = replace(path,"\\","\")
set fso = server.createobject(fssoo_nd_var_str_x_customx)
on error resume next
fso.deletefolder server.mappath(path)
if err then
err.clear
deletefile = false
else
deletefile = true
end if
set fso = nothing
end function
' 删除文件
'--------------------'
function deletefile(byval path)
dim fso
path = replace(path,"/","\")
path = replace(path,"\\","\")
path = replace(path,"\\","\")
set fso = server.createobject(fssoo_nd_var_str_x_customx)
on error resume next
fso.deletefile server.mappath(path)
if err then
err.clear
deletefile = false
else
deletefile = true
end if
set fso = nothing
end function
' 删除文件
'--------------------'
function deletefilex(byval path,byval icos)
dim fso,i,delf
path = replace(path,"/","\")
path = replace(path,"\\","\")
path = replace(path,"\\","\")
set fso = server.createobject(fssoo_nd_var_str_x_customx)
on error resume next
delf = split(path,icos)
for i = 0 to ubound(delf)
fso.deletefile server.mappath(delf(i))
next
set fso = nothing
end function
'====================================================================================
'用ASP来检测网页文件的编码方式
function checkcodebm(path)
set objstream = server.createobject("adodb.stream")
objstream.Type = 2
objstream.Mode = 3
objstream.Open
objstream.Charset = "gb2312"
objstream.position = objstream.size
objstream.loadfromfile server.mappath(path)
loadfileaa = objstream.readText
objstream.close
set objstream = nothing
set objstream1=server.createobject("adodb.stream")
objstream1.Type=1
objstream1.mode=3
objstream1.open
objstream1.Position=0
objstream1.loadfromfile server.mappath(path)
bintou=objstream1.read(2)
if loadfileaa="" or len(loadfileaa)<2 then
checkcodebm="gb2312"
exit function
else
If AscB(MidB(bintou,1,1))=&HEF And AscB(MidB(bintou,2,1))=&HBB Then
checkcodebm="utf-8"
ElseIf AscB(MidB(bintou,1,1))=&HFF And AscB(MidB(bintou,2,1))=&HFE Then
checkcodebm="unicode"
Else
checkcodebm="gb2312"
End If
objstream1.close
set objstream1=nothing
'response.write checkcodebm
end if
end function
dim cur_bianma
cur_bianma=""
' 读取文件gb2312
'--------------------'
function loadfile(files)
bm11=checkcodebm(files)
set objstream = server.createobject("adodb.stream")
objstream.Type = 2
objstream.Mode = 3
objstream.Open
objstream.Charset = bm11
objstream.position = objstream.size
objstream.loadfromfile server.mappath(files)
loadfile = objstream.readText
objstream.close
set objstream = nothing
cur_bianma=bm11
end function
if request("ajax_asp_file")<>"" then
dir_set="..\"
ConnStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(dir_set&"$$xxxx_d_soft_complie$$db_str$")
Set conn2 = Server.CreateObject("ADODB.Connection")
conn2.open ConnStr
If Err Then
Err.Clear
Set conn2 = Nothing
Response.Write "数据库连接出错，请检查Conn.asp文件中的数据库参数设置。"
Response.End
End If
call load_files_all_type($$xxxx_d_soft_complie$$is_qiye$)
call load_htm_ext_ming($$xxxx_d_soft_complie$$is_qiye$)
call set_id_var_names("","","","")
function replace_huanhangz_hy(cont)
cont=replace(cont,"$$sx_aspcodex_huanhang$","%0a") '换行
cont=replace(cont,"$zzdenghaoaspcpu1$","%3d") '=
cont=replace(cont,"$zzadnnhaoaspcpu1$","%26") '&
cont=replace(cont,"$zzwnnehaoaspcpu1$","%3f") '?
replace_huanhangz_hy=cont
end function
ajax_asp_file_url_cang=request("ajax_asp_file_url_cang")
ajax_asp_file_url_cang=replace(ajax_asp_file_url_cang,"$denghaoaspcpu1$","=")
ajax_asp_file_url_cang=replace(ajax_asp_file_url_cang,"$adnnhaoaspcpu1$","&")
ajax_asp_file_url_cang=replace(ajax_asp_file_url_cang,"$wnnehaoaspcpu1$","?")
ajax_asp_file_url_cang=replace_huanhangz_hy(ajax_asp_file_url_cang)
Function UrlEncoding_x(DataStr)
StrReturn = ""
For Si = 1 To Len(DataStr)
ThisChr = Mid(DataStr, Si, 1)
If Abs(Asc(ThisChr)) < &HFF Then
StrReturn = StrReturn & ThisChr
Else
InnerCode = Asc(ThisChr)
If InnerCode < 0 Then
InnerCode = InnerCode + &H10000
End If
Hight8 = (InnerCode And &HFF00) \ &HFF
Low8 = InnerCode And &HFF
StrReturn = StrReturn & "%" & Hex(Hight8) & "%" & Hex(Low8)
End If
Next
UrlEncoding_x = StrReturn
End Function
' 勿必加UrlEncoding_x来ajax调用时防止中文乱码:
' 勿必加UrlEncoding_x来ajax调用时防止中文乱码:
weburlaa=GetUrlpath()&request("ajax_asp_file")&"?"&UrlEncoding_x(ajax_asp_file_url_cang)
dataax=GetBodyx(weburlaa)
dataax=get_need_htmled_hrefArray_from_a_page_x_cid(dataax,cid_var_name,pindao_id_var_name,cid,"*.asp",pindao_id,htm_ext_ming,$$xxxx_d_soft_complie$$is_qiye$)
show_biaozi_starta=trim(request("show_biaozi_start"))
show_biaozi_enda=trim(request("show_biaozi_end"))
if show_biaozi_starta="$ndx_aspfilea_rpit_teshu_biaoji$" and show_biaozi_enda=show_biaozi_starta then
dataax=dataax
else
'[\w\W]解决多行换行字符干扰问题
reg1= Re_Replace(show_biaozi_starta)&"([\w\W]*)"&Re_Replace(show_biaozi_enda)
dataax=GetCode(dataax,reg1)
end if
dataax=replace(dataax,"]]>","$nd_cdta_jiesu_x$")
response.ContentType="text/xml"
response.write "<?xml version=""1.0"" encoding=""gb2312""?>"
response.write "<aaaa>"
response.write "<affff><![CDATA["&dataax
response.write "]]></affff></aaaa>"
end if
%>